Untitled

Filter Country Rows
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
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 the Report Sheet
    wsReport.Cells.Clear

    ' Get selected option (country or standard)
    selectedOption = Me.cmbOptions.Value

    If selectedOption = "" Then
        MsgBox "Please select an option from the dropdown.", vbExclamation
        Exit Sub
    End If

    ' Determine the column range for the selected option
    Call SetHeaderRange(wsMain, selectedOption, startCol, endCol)
    If startCol = 0 Or endCol = 0 Then Exit Sub ' Exit if range not found

    ' Copy headers
    Call CopyHeadersAndData(wsMain, wsReport, startCol, endCol)

    ' Remove rows with all blank cells in the selected range
    Call FilterAndRemoveBlankRows(wsReport, startCol, endCol)

    MsgBox "Report generated successfully!", vbInformation
End Sub

Private Sub SetHeaderRange(ws As Worksheet, selectedOption As String, ByRef startCol As Long, ByRef endCol As Long)
    Dim headerRange As Range

    ' Find the header for the selected option
    Set headerRange = ws.Rows(2).Find(What:=selectedOption, LookIn:=xlValues, LookAt:=xlWhole)
    If Not headerRange Is Nothing Then
        startCol = headerRange.Column
        endCol = headerRange.MergeArea.Columns.Count + startCol - 1
    Else
        MsgBox "Selected option not found in headers!", vbExclamation
        startCol = 0
        endCol = 0
    End If
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 additionalHeadersStart As Long, additionalHeadersEnd As Long

    ' Define ranges for additional headers
    additionalHeadersStart = 30 ' Column AD
    additionalHeadersEnd = 54  ' Column BB

    ' Copy general headers (A:D)
    wsMain.Range("A1:D3").Copy Destination:=wsReport.Range("A1")

    ' Copy selected range 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, additionalHeadersStart), wsMain.Cells(3, additionalHeadersEnd)).Copy _
        Destination:=wsReport.Cells(1, 5 + (endCol - startCol + 1))

    ' Copy data
    lastRow = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row
    reportRow = 4

    For i = 4 To lastRow
        ' Copy general data (A:D)
        wsMain.Range(wsMain.Cells(i, 1), wsMain.Cells(i, 4)).Copy _
            Destination:=wsReport.Cells(reportRow, 1)

        ' Copy selected range data
        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, additionalHeadersStart), wsMain.Cells(i, additionalHeadersEnd)).Copy _
            Destination:=wsReport.Cells(reportRow, 5 + (endCol - startCol + 1))

        reportRow = reportRow + 1
    Next i
End Sub

Private Sub FilterAndRemoveBlankRows(wsReport As Worksheet, startCol As Long, endCol As Long)
    Dim lastRow As Long
    Dim i As Long
    Dim isRowEmpty As Boolean

    lastRow = wsReport.Cells(wsReport.Rows.Count, 1).End(xlUp).Row

    For i = lastRow To 4 Step -1
        isRowEmpty = True

        ' Check if any cell in the selected range has content
        For col = startCol To endCol
            If Not IsEmpty(wsReport.Cells(i, col).Value) Then
                isRowEmpty = False
                Exit For
            End If
        Next col

        ' Delete row if all cells in the selected range are empty
        If isRowEmpty Then
            wsReport.Rows(i).Delete
        End If
    Next i
End Sub