Untitled
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
Leave a Comment