Private Sub cmdReportInTables_Click()
Dim l_wkbCurrent As Workbook
Dim l_wksReport As Worksheet
Dim l_wksTable As Worksheet
Dim l_lRow As Long
Dim l_lMaxRow As Long
Dim l_lReportRow As Long
Dim l_bNewTable As Boolean
Dim l_sCurrentCategory As String
Set l_wkbCurrent = ThisWorkbook
Set l_wksTable = l_wkbCurrent.Sheets("Saf037")
If SheetExists(l_wkbCurrent, "PivotReport") Then
'Take the existing report & clear
Set l_wksReport = l_wkbCurrent.Sheets("PivotReport")
l_wksReport.UsedRange.Clear
Else
'Create new report
Set l_wksReport = l_wkbCurrent.Sheets.Add
l_wksReport.Name = "PivotReport"
End If
'Determine max number of rows
l_lMaxRow = l_wksTable.UsedRange.Rows.Count
'Determine if there are any empty formatted rows coz' Excel will include these in the UsedRange
For l_lRow = l_lMaxRow To 1
If l_wksTable.Cells(l_lRow, 1) <> "" Then
l_lMaxRow = l_lRow
Exit For
End If
Next l_lRow
'Now sort the table on column Description - this to get the groups together
l_wksTable.Range("Table").Sort Key1:="main category", Order1:=xlAscending, Header:=xlYes
'Set check string which'll check to see if a new MainCategory table should be created
l_sCurrentCategory = l_wksTable.Cells(2, 4)
'Set Newtable boolean to TRUE - the first table's new & should get a header
l_bNewTable = True
'Set startrow of report to 1
l_lReportRow = 1
'report per group on separate report sheet
For l_lRow = 2 To l_lMaxRow
'Create header if new table
If l_bNewTable Then
'Report Main Category
l_wksReport.Cells(l_lReportRow, 1) = l_sCurrentCategory
l_lReportRow = l_lReportRow + 1
'Table header
l_wksReport.Cells(l_lReportRow, 1) = "Code"
l_wksReport.Cells(l_lReportRow, 2) = "Description"
l_lReportRow = l_lReportRow + 1
'Set NewTable boolean to FALSE - we only need this once per table
l_bNewTable = False
End If
'Report items for this category
l_wksReport.Cells(l_lReportRow, 1) = l_wksTable.Cells(l_lRow, 1)
l_wksReport.Cells(l_lReportRow, 2) = l_wksTable.Cells(l_lRow, 2)
'Move to new row on report sheet
l_lReportRow = l_lReportRow + 1
'Test to check if a new table should be started
If l_wksTable.Cells(l_lRow + 1, 4) <> l_sCurrentCategory Then
'Set NewTable variables
l_bNewTable = True
l_sCurrentCategory = l_wksTable.Cells(l_lRow + 1, 4)
'Add extra empty row between the current and the new table
l_lReportRow = l_lReportRow + 1
End If
Next l_lRow
'release objects - just in case xl gets nasty
Set l_wksReport = Nothing
Set l_wksTable = Nothing
Set l_wkbCurrent = Nothing
End Sub
Private Function SheetExists(p_wkbWorkbook As Workbook, p_sWorksheetName As String) As Boolean
On Error GoTo ErrExit
'Assume the sheet does not exist
SheetExists = False
'Try to activate it: if xl can't, the error handler will close the Function & return FALSE
p_wkbWorkbook.Sheets(p_sWorksheetName).Activate
'The sheet exists - return TRUE!
SheetExists = True
ErrExit:
End Function