Work on our test suite continues for both automated and manual test scenarios. In my spare time I have been developing a macro that can be applied to each of our test scenario spreadsheets that will give everyone a front page / summary page to view vital information. Information such as Acceptance Tests that have Failed, Acceptance Tests that have been Executed, Scenarios that are Automated and so on. It’s been an interesting experience, since I have not worked with VBA like this before.
The script I have written came about in 2 steps. First, I had developed all of the “Fixed” column handling such as Acceptance test details. Second, I developed all of the “Dynamic” column handling such as the environment configurations needed for a test cycle. The script itself is pretty heavily documented, so check it out below.
Some things to note about this.
1) It is functional but not robust. Error handling is minimal since this is an internal tool.
2) A Summary tab must exist before executing it.
3) Blank tabs or missing column headers will cause the script to fail (see note #1).
Public environmentArray(1 To 25) As String
Public globalRegressionStartPosition As Integer
Sub Auto_Open()
environmentArray(1) = "2KIE6"
environmentArray(2) = "XPFF3.x"
environmentArray(3) = "XPIE7"
environmentArray(4) = "Mac 10.5/Firefox3/3.5"
environmentArray(5) = "Mac 10.5/Safari"
environmentArray(6) = "Mac 10.4/FireFox3/3.5"
environmentArray(7) = "Mac 10.4/Safari"
‘Where regression test tracking begins
globalRegressionStartPosition = 7
Dim myRange As Range
Dim k As Integer, i As Integer, sheetTotal As Integer
Dim sheetName As String
‘Create the body of the Summary Page
CreateSummaryHeader
CountTestScenarios
CountAcceptanceTests
CountAcceptanceFails
CountAcceptanceExecuted
CountAutomatedTests
CountRegressionFails
CountRegressionExecutions
CreateSummaryFooter
End Sub
Public Function FindRow(rowName)
Dim l As Long
If rowName <> "" And rowName <> Empty Then
l = Application.WorksheetFunction.Match(rowName, ActiveSheet.Range("A1:Z1"), 0)
FindRow = l
End If
End Function
Public Function FindColumn(columnName)
Dim l As Long
l = Application.WorksheetFunction.Match(columnName, ActiveSheet.Range("A1:A100"), 0)
FindColumn = l
End Function
Public Function CreateSummaryHeader()
testTotal = 0
‘Reset active sheet to "Summary" for updating
Application.Sheets("Summary").Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
Application.ActiveCell(1, 1) = "Module/Submodule/Work Item Name"
Application.ActiveCell(1, 2) = "Total No of TS’s"
Application.ActiveCell(1, 3) = "Total No Acceptance Tests"
Application.ActiveCell(1, 4) = "Total Acceptance Tests Fail"
Application.ActiveCell(1, 5) = "Total Acceptance Tests Executed"
Application.ActiveCell(1, 6) = "Automated"
CreateRegressionHeaders
‘Apply color to header row
Range("A1:Z2").Interior.Color = RGB(128, 128, 128)
‘Apply border line style
Range(Cells(1, 1), Cells(45, 45)).Borders.LineStyle = xlSolid
‘Apply Font
Range("A1:Z2").Font.Name = "Calibri"
‘Apply Horizontal Justification
Range("A1:Z2").HorizontalAlignment = xlCenter
‘Apply Vertical Justification
Range("A1:Z2").VerticalAlignment = xlTop
‘Give us some room so the tab titles do not extend outside of the cell
Columns("A:A").ColumnWidth = 45
Columns("B:B").ColumnWidth = 15
Columns("C:D").ColumnWidth = 22
Columns("E:E").ColumnWidth = 25
End Function
Public Function CreateRegressionHeaders()
‘Clean up any preious runs to preserve formatting
[A1:Z1].UnMerge
maxArrayValue = UBound(environmentArray)
‘Activate the cell past all the other column headings
Application.ActiveCell(1, globalRegressionStartPosition).Activate
‘Label the columns with Environmental Configurations
‘Label the 2 cells below the Environment Configurations with Executed and Failed
For i = globalRegressionStartPosition To maxArrayValue
If environmentArray(i – 6) = "" Then
Exit For
End If
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 1)).Merge
Application.ActiveCell(1, 1) = environmentArray(i – 6)
If environmentArray(i – 6) <> "" Then
Application.ActiveCell(2, 1) = "Failed"
Application.ActiveCell(2, 2) = "Executed"
End If
Application.ActiveCell(1, globalRegressionStartPosition – 4).Activate
Next i
End Function
Public Function CountTestScenarios()
Dim headerName As String
Dim headerRow As Integer
headerName = "Total No of TS’s"
headerRow = FindRow(headerName)
‘Get the number of Worksheets in the Workbook
k = Worksheets.Count
For i = 2 To k
‘Activate the next Worksheet
Application.Sheets(i).Activate
‘Counts cells in B Column that have data
Set Rng = ActiveSheet.Range(Cells(2, headerRow), Cells(Rows.Count, headerRow).End(xlUp)).SpecialCells(xlCellTypeVisible)
‘Get worksheet total cells with data, remove 3 to account for headings. they dont count.
sheetTotal = Application.WorksheetFunction.CountA(Rng) – 3
‘total up all test cases found.
testTotal = testTotal + sheetTotal
‘Get current worksheet name
sheetName = ActiveSheet.Name
‘Reset active sheet to "Summary" for updating
Application.Sheets("Summary").Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
‘Put sheet name into row A, cell i
Application.ActiveCell(i + 1, 1) = sheetName
‘Put the sheet total into row B, cell i
Application.ActiveCell(i + 1, headerRow) = sheetTotal
Next i
‘Add a Total column label
Application.ActiveCell(i + 1, 1) = "Total"
End Function
Public Function CreateSummaryFooter()
Dim totalColumnExists As Boolean
Dim columnPosition As Integer
totalColumnExists = False
‘Update the sheet with the totals for all test cases
Application.Sheets("Summary").Activate
Application.Cells(2, 1).Activate
columnPosition = FindColumn("Total")
i = columnPosition – 1
totalTS = FindRow("Total No of TS’s")
Application.ActiveCell(i, totalTS) = testTotal
End Function
Public Function CountScenarioFails()
Dim SummaryrowName As String, Count As Integer
SummaryrowName = "Total TS Fail"
‘Get the number of Worksheets in the Workbook
k = Worksheets.Count
For i = 2 To k
‘Activate the next Worksheet
Application.Sheets(i).Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
failRow = FindRow("Pass / Fail")
‘Counts cells in B Column that have data
Set Rng = ActiveSheet.Range(Cells(failRow, 5), Cells(Rows.Count, failRow).End(xlUp)).SpecialCells(xlCellTypeVisible)
Dim subRng As Range
For Each subRng In Rng
If subRng.Value = "Fail" Then
Count = Count + 1
End If
Next subRng
UpdateSheetCount SummaryrowName, Count
Count = 0
Next i
GetAndWriteTotal (SummaryrowName)
End Function
Public Function GetAndWriteTotal(columnName)
Dim totalFailRange As Range
rowPosition = FindColumn("Total")
columnPosition = FindRow(columnName)
With ActiveSheet
Set totalFailRange = .Range(.Cells(rowPosition – 1, columnPosition), .Cells(3, columnPosition).End(xlUp))
sumRng = Application.WorksheetFunction.Sum(totalFailRange)
Application.ActiveCell(rowPosition, columnPosition) = sumRng
End With
End Function
Public Function CountScenarioExecuted()
Dim rowName As String
SummaryrowName = "Total TS Executed"
‘Get the number of Worksheets in the Workbook
k = Worksheets.Count
For i = 2 To k
‘Activate the next Worksheet
Application.Sheets(i).Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
failRow = FindRow("Pass / Fail")
‘Counts cells in B Column that have data
Set Rng = ActiveSheet.Range(Cells(failRow, 5), Cells(Rows.Count, failRow).End(xlUp)).SpecialCells(xlCellTypeVisible)
Dim subRng As Range
For Each subRng In Rng
If subRng.Value = "Fail" Or subRng.Value = "Pass" Then
Count = Count + 1
End If
Next subRng
UpdateSheetCount SummaryrowName, Count
Count = 0
Next i
GetAndWriteTotal (SummaryrowName)
End Function
Public Function CountAcceptanceTests()
Dim SummaryrowName As String, Count As Integer
SummaryrowName = "Total No Acceptance Tests"
i = 0
‘Get the number of Worksheets in the Workbook
k = Worksheets.Count
For i = 2 To k
‘Activate the next Worksheet
Application.Sheets(i).Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
Row = FindRow("Acceptance Priority")
‘Counts cells in B Column that have data
Set Rng = ActiveSheet.Range(Cells(5, Row), Cells(Rows.Count, Row).End(xlUp)).SpecialCells(xlCellTypeVisible)
Dim subRng As Range
For Each subRng In Rng
If subRng.Value = 1 Then
Count = Count + 1
End If
Next subRng
UpdateSheetCount SummaryrowName, Count
Count = 0
Next i
GetAndWriteTotal (SummaryrowName)
End Function
Public Function CountAcceptanceFails()
Dim SummaryrowName As String, Count As Integer
SummaryrowName = "Total Acceptance Tests Fail"
i = 0
‘Get the number of Worksheets in the Workbook
k = Worksheets.Count
For i = 2 To k
‘Activate the next Worksheet
Application.Sheets(i).Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
Row = FindRow("Pass / Fail")
‘Counts cells that have data
Set Rng = ActiveSheet.Range(Cells(5, Row), Cells(Rows.Count, Row).End(xlUp)).SpecialCells(xlCellTypeVisible)
‘The count is only valid if it is also marked as an Acceptance Test.
secondaryRow = FindRow("Acceptance Priority")
Dim subRng As Range
For Each subRng In Rng
If subRng.Value = "Fail" Then
If Application.Cells(subRng.Row, secondaryRow).Value = 1 Then
Count = Count + 1
End If
End If
Next subRng
UpdateSheetCount SummaryrowName, Count
Count = 0
Next i
GetAndWriteTotal (SummaryrowName)
End Function
Function CountAcceptanceExecuted()
Dim SummaryrowName As String, Count As Integer
SummaryrowName = "Total Acceptance Tests Executed"
i = 0
‘Get the number of Worksheets in the Workbook
k = Worksheets.Count
For i = 2 To k
‘Activate the next Worksheet
Application.Sheets(i).Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
Row = FindRow("Pass / Fail")
‘Counts cells that have data
Set Rng = ActiveSheet.Range(Cells(5, Row), Cells(Rows.Count, Row).End(xlUp)).SpecialCells(xlCellTypeVisible)
‘The count is only valid if it is also marked as an Acceptance Test.
secondaryRow = FindRow("Acceptance Priority")
Dim subRng As Range
For Each subRng In Rng
If subRng.Value = "Fail" Or subRng.Value = "Pass" Then
If Application.Cells(subRng.Row, secondaryRow).Value = 1 Then
Count = Count + 1
End If
End If
Next subRng
UpdateSheetCount SummaryrowName, Count
Count = 0
Next i
GetAndWriteTotal (SummaryrowName)
End Function
Function CountAutomatedTests()
Dim SummaryrowName As String, Count As Integer
SummaryrowName = "Automated"
i = 0
‘Get the number of Worksheets in the Workbook
k = Worksheets.Count
For i = 2 To k
‘Activate the next Worksheet
Application.Sheets(i).Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
Row = FindRow("Automated ?")
‘Counts cells that have data
Set Rng = ActiveSheet.Range(Cells(5, Row), Cells(Rows.Count, Row).End(xlUp)).SpecialCells(xlCellTypeVisible)
Dim subRng As Range
For Each subRng In Rng
If subRng.Value = "Yes" Then
Count = Count + 1
End If
Next subRng
UpdateSheetCount SummaryrowName, Count
Count = 0
Next i
GetAndWriteTotal (SummaryrowName)
End Function
Function UpdateSheetCount(rowName As String, Count As Integer)
‘Get current worksheet name
sheetName = ActiveSheet.Name
‘Reset active sheet to "Summary" for updating
Application.Sheets("Summary").Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
columnPosition = FindColumn(sheetName)
rowPosition = FindRow(rowName)
Application.ActiveCell(columnPosition, rowPosition) = Count
End Function
Public Function CountRegressionFails()
Dim RegressionName As String, Count As Integer
For RegressionConfig = 1 To UBound(environmentArray)
RegressionName = environmentArray(RegressionConfig)
If RegressionName <> "" And RegressionName <> Empty Then
‘Get the number of Worksheets in the Workbook
k = Worksheets.Count
For ScenarioWorksheet = 2 To k
‘Activate the next Worksheet
Application.Sheets(ScenarioWorksheet).Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
failRow = FindRow(RegressionName)
‘Counts cells that have data
Set Rng = ActiveSheet.Range(Cells(5, failRow), Cells(Rows.Count, failRow).End(xlUp)).SpecialCells(xlCellTypeVisible)
Dim subRng As Range
For Each subRng In Rng
If subRng.Value = "Fail" Then
Count = Count + 1
End If
Next subRng
UpdateSheetCount RegressionName, Count
Count = 0
Next ScenarioWorksheet
GetAndWriteTotal (RegressionName)
End If
Next RegressionConfig
End Function
Public Function CountRegressionExecutions()
Dim RegressionName As String, Count As Integer
For RegressionConfig = 1 To UBound(environmentArray)
RegressionName = environmentArray(RegressionConfig)
If RegressionName <> "" And RegressionName <> Empty Then
‘Get the number of Worksheets in the Workbook
k = Worksheets.Count
For ScenarioWorksheet = 2 To k
‘Activate the next Worksheet
Application.Sheets(ScenarioWorksheet).Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
failRow = FindRow(RegressionName)
‘Counts cells that have data
Set Rng = ActiveSheet.Range(Cells(5, failRow), Cells(Rows.Count, failRow).End(xlUp)).SpecialCells(xlCellTypeVisible)
Dim subRng As Range
For Each subRng In Rng
If subRng.Value = "Fail" Or subRng.Value = "Pass" Then
Count = Count + 1
End If
Next subRng
‘Get current worksheet name
sheetName = ActiveSheet.Name
‘Reset active sheet to "Summary" for updating
Application.Sheets("Summary").Activate
‘Reset active cell to A1
Application.Cells(1, 1).Activate
columnPosition = FindColumn(sheetName)
rowPosition = FindRow(RegressionName) + 1
Application.ActiveCell(columnPosition, rowPosition) = Count
Count = 0
Next ScenarioWorksheet
Dim totalFailRange As Range
rowPosition = FindColumn("Total")
columnPosition = FindRow(RegressionName) + 1
With ActiveSheet
Set totalFailRange = .Range(.Cells(rowPosition – 1, columnPosition), .Cells(rowPosition, columnPosition).End(xlUp))
sumRng = Application.WorksheetFunction.Sum(totalFailRange)
Application.ActiveCell(rowPosition, columnPosition) = sumRng
End With
End If
Next RegressionConfig
End Function
Feel free to download the files below. Send me any suggestions or updates!
Download Excel Spreadsheet
Download VBA Script Only
Related posts:
Pingback: Summary Sheet in Excel using VBA Macro « Croutons of Life