Untitled
unknown
plain_text
a year ago
3.9 kB
12
Indexable
Private Sub btnGenerateReport_Click()
Dim wsMain As Worksheet
Dim wsReport As Worksheet
Dim lastRow As Long
Dim selectedOption As String
Dim startCol As Long, endCol As Long
Dim reportRow As Long
Set wsMain = ThisWorkbook.Sheets("Integrated Control sheet")
Set wsReport = ThisWorkbook.Sheets("Report Sheet")
' Clear previous data in the report sheet
wsReport.Cells.Clear
' Get the selected option from ComboBox
selectedOption = Me.cmbOptions.Value
If selectedOption = "" Then
MsgBox "Please select an option from the dropdown.", vbExclamation
Exit Sub
End If
' Get column range for selected option
If Me.optCountry.Value Then
SetHeaderRange wsMain, selectedOption, startCol, endCol, 5, 21 ' Columns E to U
ElseIf Me.optStandard.Value Then
SetHeaderRange wsMain, selectedOption, startCol, endCol, 22, 29 ' Columns V to AC
End If
If startCol = 0 Then
MsgBox "Selected option not found in headers.", vbExclamation
Exit Sub
End If
' Copy headers and data to Report Sheet
CopyHeadersAndData wsMain, wsReport, startCol, endCol
' Filter rows to remove blanks within the selected column range
FilterAndRemoveBlankRows wsReport, startCol, endCol
MsgBox "Report generated successfully!", vbInformation
End Sub
Private Sub SetHeaderRange(ws As Worksheet, optionValue As String, ByRef startCol As Long, ByRef endCol As Long, colStart As Long, colEnd As Long)
Dim i As Long
startCol = 0
endCol = 0
' Identify start and end column for the selected option
For i = colStart To colEnd
If ws.Cells(2, i).Value = optionValue Then
startCol = i
endCol = ws.Cells(2, i).MergeArea.Columns.Count + startCol - 1
Exit For
End If
Next i
End Sub
Private Sub CopyHeadersAndData(wsMain As Worksheet, wsReport As Worksheet, startCol As Long, endCol As Long)
Dim lastRow As Long
Dim reportRow As Long
Dim i As Long
' Copy general headers (A:D)
wsMain.Range("A1:D3").Copy Destination:=wsReport.Range("A1")
' Copy selected option headers
wsMain.Range(wsMain.Cells(1, startCol), wsMain.Cells(3, endCol)).Copy _
Destination:=wsReport.Cells(1, 5)
' Copy additional headers (AD:BB)
wsMain.Range(wsMain.Cells(1, 30), wsMain.Cells(3, 54)).Copy _
Destination:=wsReport.Cells(1, 5 + (endCol - startCol + 1))
' Copy rows based on filters
lastRow = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row
reportRow = 4 ' Start copying data from row 4
For i = 4 To lastRow
' Always copy general data (A:D)
wsMain.Range(wsMain.Cells(i, 1), wsMain.Cells(i, 4)).Copy _
Destination:=wsReport.Cells(reportRow, 1)
' Copy data for selected column range
wsMain.Range(wsMain.Cells(i, startCol), wsMain.Cells(i, endCol)).Copy _
Destination:=wsReport.Cells(reportRow, 5)
' Copy additional data (AD:BB)
wsMain.Range(wsMain.Cells(i, 30), wsMain.Cells(i, 54)).Copy _
Destination:=wsReport.Cells(reportRow, 5 + (endCol - startCol + 1))
reportRow = reportRow + 1
Next i
End Sub
Private Sub FilterAndRemoveBlankRows(ws As Worksheet, startCol As Long, endCol As Long)
Dim lastRow As Long
Dim i As Long
Dim isRowEmpty As Boolean
Dim j As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' Loop through rows from bottom to top
For i = lastRow To 4 Step -1
isRowEmpty = True
' Check if all cells in the selected column range are blank
For j = startCol To endCol
If ws.Cells(i, j).Value <> "" Then
isRowEmpty = False
Exit For
End If
Next j
' Delete row if empty
If isRowEmpty Then
ws.Rows(i).Delete
End If
Next i
End Sub
Editor is loading...
Leave a Comment