Untitled

Private Sub UserForm_Initialize()
    Call PopulateOptions
End Sub

Private Sub optCountry_Click()
    Call PopulateOptions
End Sub

Private Sub optStandard_Click()
    Call PopulateOptions
End Sub

Private Sub PopulateOptions()
    Dim ws As Worksheet
    Dim i As Long
    Dim uniqueDomains As Object, uniqueRiskPriorities As Object

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

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

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

    ' Populate unique domains (Column A)
    For i = 4 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        If ws.Cells(i, 1).Value <> "" Then
            If Not uniqueDomains.exists(ws.Cells(i, 1).Value) Then
                uniqueDomains.Add ws.Cells(i, 1).Value, True
                Me.lstDomain.AddItem ws.Cells(i, 1).Value
            End If
        End If
    Next i

    ' Populate unique risk priorities (Column AR)
    For i = 4 To ws.Cells(ws.Rows.Count, 44).End(xlUp).Row
        If ws.Cells(i, 44).Value <> "" Then
            If Not uniqueRiskPriorities.exists(ws.Cells(i, 44).Value) Then
                uniqueRiskPriorities.Add ws.Cells(i, 44).Value, True
                Me.lstRiskPriority.AddItem ws.Cells(i, 44).Value
            End If
        End If
    Next i
End Sub

Private Sub btnGenerateReport_Click()
    Dim wsMain As Worksheet, wsReport As Worksheet, wbNew As Workbook
    Dim selectedOption As String, selectedDomains As Object, selectedRiskPriorities As Object
    Dim startCol As Long, endCol As Long, reportRow As Long
    Dim i As Long, lastRow As Long, optionFound As Boolean

    Set wsMain = ThisWorkbook.Sheets("Integrated Control sheet")
    Set wsReport = ThisWorkbook.Sheets("Report Sheet")
    Set selectedDomains = CreateObject("Scripting.Dictionary")
    Set selectedRiskPriorities = CreateObject("Scripting.Dictionary")

    wsReport.Cells.Clear ' Clear previous report data

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

    ' Get selected domains
    For i = 0 To Me.lstDomain.ListCount - 1
        If Me.lstDomain.Selected(i) Then
            selectedDomains.Add Me.lstDomain.List(i), True
        End If
    Next i

    ' Get selected risk priorities
    For i = 0 To Me.lstRiskPriority.ListCount - 1
        If Me.lstRiskPriority.Selected(i) Then
            selectedRiskPriorities.Add Me.lstRiskPriority.List(i), True
        End If
    Next i

    ' Find start and end columns for selected option
    If Me.optCountry.Value Then
        Dim headerRange As Range
        Set headerRange = wsMain.Rows(2).Find(What:=selectedOption, LookIn:=xlValues, LookAt:=xlWhole)
        If headerRange Is Nothing Then
            MsgBox "Country not found!", vbExclamation
            Exit Sub
        End If
        startCol = headerRange.Column
        endCol = headerRange.MergeArea.Columns.Count + startCol - 1
    ElseIf Me.optStandard.Value Then
        For i = 22 To 29
            If wsMain.Cells(2, i).Value = selectedOption Then
                startCol = i
                endCol = i
                Exit For
            End If
        Next i
    End If

    ' Copy headers
    wsMain.Range("A1:D3").Copy wsReport.Range("A1")
    wsMain.Range(wsMain.Cells(1, startCol), wsMain.Cells(3, endCol)).Copy wsReport.Cells(1, 5)
    wsMain.Range(wsMain.Cells(1, 30), wsMain.Cells(3, 54)).Copy wsReport.Cells(1, 5 + (endCol - startCol + 1))

    ' Copy data rows based on filters
    lastRow = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row
    reportRow = 4
    For i = 4 To lastRow
        If (selectedDomains.exists(wsMain.Cells(i, 1).Value) Or selectedDomains.Count = 0) And _
           (selectedRiskPriorities.exists(wsMain.Cells(i, 44).Value) Or selectedRiskPriorities.Count = 0) Then
            wsMain.Range(wsMain.Cells(i, 1), wsMain.Cells(i, 4)).Copy wsReport.Cells(reportRow, 1)
            wsMain.Range(wsMain.Cells(i, startCol), wsMain.Cells(i, endCol)).Copy wsReport.Cells(reportRow, 5)
            wsMain.Range(wsMain.Cells(i, 30), wsMain.Cells(i, 54)).Copy wsReport.Cells(reportRow, 5 + (endCol - startCol + 1))
            reportRow = reportRow + 1
        End If
    Next i

    ' Remove rows with all blank country columns
    Call RemoveBlankCountryRows(wsReport, startCol, endCol)

    ' Save the report
    Set wbNew = Application.Workbooks.Add
    wsReport.Copy Before:=wbNew.Sheets(1)
    wbNew.Sheets(1).Name = "Generated Report"
    Dim newFileName As String
    newFileName = Application.GetSaveAsFilename(InitialFileName:="Generated_Report.xlsx", FileFilter:="Excel Files (*.xlsx), *.xlsx")
    If newFileName <> "False" Then
        wbNew.SaveAs newFileName, FileFormat:=xlOpenXMLWorkbook
        MsgBox "Report generated and saved successfully!", vbInformation
    Else
        MsgBox "Report generation canceled.", vbExclamation
    End If
    wbNew.Close SaveChanges:=False
    Unload Me
End Sub

Private Sub RemoveBlankCountryRows(wsReport As Worksheet, startCol As Long, endCol As Long)
    Dim lastRow As Long, i As Long
    lastRow = wsReport.Cells(wsReport.Rows.Count, 1).End(xlUp).Row
    For i = lastRow To 4 Step -1
        If WorksheetFunction.CountA(wsReport.Range(wsReport.Cells(i, startCol), wsReport.Cells(i, endCol))) = 0 Then
            wsReport.Rows(i).Delete
        End If
    Next i
End Sub