Untitled

Private Sub UserForm_Initialize()
    ' Initialize the user form and populate dropdown and list boxes
    Call PopulateOptions
End Sub

Private Sub optCountry_Click()
    ' Refresh options when Country is selected
    Call PopulateOptions
End Sub

Private Sub optStandard_Click()
    ' Refresh options when Standard is selected
    Call PopulateOptions
End Sub

Private Sub PopulateOptions()
    ' Populates dropdown and list boxes based on the selected option (Country/Standard)
    Dim ws As Worksheet
    Dim i As Long
    Dim uniqueDomains As Object
    Dim uniquePriorities As Object
    Dim lastRow As Long

    Set ws = ThisWorkbook.Sheets("Integrated Control sheet")
    Set uniqueDomains = CreateObject("Scripting.Dictionary")
    Set uniquePriorities = CreateObject("Scripting.Dictionary")

    ' Clear existing options
    Me.cmbOptions.Clear
    Me.lstDomain.Clear
    Me.lstRiskPriority.Clear

    ' Populate dropdown with Country or Standard options
    If Me.optCountry.Value Then
        For i = 5 To 21 ' Columns E to U for countries
            If ws.Cells(2, i).Value <> "" Then Me.cmbOptions.AddItem ws.Cells(2, i).Value
        Next i
    ElseIf Me.optStandard.Value Then
        For i = 22 To 29 ' Columns V to AC for standards
            If ws.Cells(2, i).Value <> "" Then Me.cmbOptions.AddItem ws.Cells(2, i).Value
        Next i
    End If

    ' Populate unique Domains (Column A)
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    For i = 4 To lastRow
        If ws.Cells(i, 1).Value <> "" Then uniqueDomains(ws.Cells(i, 1).Value) = True
    Next i

    For Each key In uniqueDomains.Keys
        Me.lstDomain.AddItem key
    Next key

    ' Populate unique Risk Priorities (Column AR)
    For i = 4 To lastRow
        If ws.Cells(i, 44).Value <> "" Then uniquePriorities(ws.Cells(i, 44).Value) = True
    Next i

    For Each key In uniquePriorities.Keys
        Me.lstRiskPriority.AddItem key
    Next key
End Sub

Private Sub btnGenerateReport_Click()
    ' Main logic for generating the report based on filters
    Dim wsMain As Worksheet
    Dim wsReport As Worksheet
    Dim lastRow As Long, reportRow As Long
    Dim selectedOption As String
    Dim selectedDomains As Object, selectedPriorities As Object
    Dim startCol As Long, endCol As Long
    Dim i As Long, j As Long
    Dim newFileName As String

    Set wsMain = ThisWorkbook.Sheets("Integrated Control sheet")
    Set wsReport = ThisWorkbook.Sheets("Report Sheet")

    ' Get selected option from dropdown
    selectedOption = Me.cmbOptions.Value
    If selectedOption = "" Then
        MsgBox "Please select an option from the dropdown.", vbExclamation
        Exit Sub
    End If

    ' Store selected filters in dictionaries
    Set selectedDomains = CreateObject("Scripting.Dictionary")
    Set selectedPriorities = CreateObject("Scripting.Dictionary")

    For i = 0 To Me.lstDomain.ListCount - 1
        If Me.lstDomain.Selected(i) Then selectedDomains(Me.lstDomain.List(i)) = True
    Next i

    For i = 0 To Me.lstRiskPriority.ListCount - 1
        If Me.lstRiskPriority.Selected(i) Then selectedPriorities(Me.lstRiskPriority.List(i)) = True
    Next i

    ' Identify column range for the selected option (Country or Standard)
    If Me.optCountry.Value Then
        For j = 5 To 21 ' Columns E to U
            If wsMain.Cells(2, j).Value = selectedOption Then
                startCol = j
                endCol = j
                Exit For
            End If
        Next j
    ElseIf Me.optStandard.Value Then
        For j = 22 To 29 ' Columns V to AC
            If wsMain.Cells(2, j).Value = selectedOption Then
                startCol = j
                endCol = j
                Exit For
            End If
        Next j
    End If

    If startCol = 0 Or endCol = 0 Then
        MsgBox "Option not found in the headers.", vbExclamation
        Exit Sub
    End If

    ' Clear the Report Sheet and copy headers
    wsReport.Cells.Clear
    wsMain.Rows(1).Copy Destination:=wsReport.Rows(1)

    ' Generate filtered data for the report
    lastRow = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row
    reportRow = 4

    For i = 4 To lastRow
        If (selectedDomains.Count = 0 Or selectedDomains.exists(wsMain.Cells(i, 1).Value)) And _
           (selectedPriorities.Count = 0 Or selectedPriorities.exists(wsMain.Cells(i, 44).Value)) Then

            ' Copy row if filters match
            wsMain.Range(wsMain.Cells(i, 1), wsMain.Cells(i, endCol)).Copy _
                Destination:=wsReport.Cells(reportRow, 1)
            reportRow = reportRow + 1
        End If
    Next i

    ' Remove rows where selected columns are blank
    Call RemoveBlankRows(wsReport, startCol, endCol)

    ' Prompt user to save the report
    newFileName = Application.GetSaveAsFilename(InitialFileName:="Generated_Report.xlsx", FileFilter:="Excel Files (*.xlsx), *.xlsx")
    If newFileName <> "False" Then
        wsReport.Parent.SaveAs newFileName, FileFormat:=xlOpenXMLWorkbook
        MsgBox "Report generated successfully!", vbInformation
    Else
        MsgBox "Report generation canceled.", vbExclamation
    End If
End Sub

Private Sub RemoveBlankRows(ws As Worksheet, startCol As Long, endCol As Long)
    ' Removes rows where the selected columns are blank
    Dim lastRow As Long
    Dim i As Long

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

    For i = lastRow To 4 Step -1
        If WorksheetFunction.CountA(ws.Range(ws.Cells(i, startCol), ws.Cells(i, endCol))) = 0 Then
            ws.Rows(i).Delete
        End If
    Next i
End Sub