Untitled

 avatar
unknown
plain_text
18 days ago
9.5 kB
2
Indexable
Private Sub lstDomain_Click()

End Sub

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 lastRow As Long
    Dim uniqueDomains As Object
    Dim uniqueRiskPriorities As Object
    Dim cellValue As String

    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 ComboBox for Country or Standard
    If Me.optCountry.Value Then
        ' Populate combo box with countries (E to U)
        For i = 5 To 21 ' Columns E to U
            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 combo box with standards (V to AC)
        For i = 22 To 29 ' Columns V to AC
            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)
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    For i = 4 To lastRow
        cellValue = ws.Cells(i, 1).Value
        If cellValue <> "" And Not uniqueDomains.exists(cellValue) Then
            uniqueDomains.Add cellValue, True
            Me.lstDomain.AddItem cellValue
        End If
    Next i

    ' Populate unique Risk Priorities (Column AR)
    For i = 4 To lastRow
        cellValue = ws.Cells(i, 44).Value ' Column AR is 44th column
        If cellValue <> "" And Not uniqueRiskPriorities.exists(cellValue) Then
            uniqueRiskPriorities.Add cellValue, True
            Me.lstRiskPriority.AddItem cellValue
        End If
    Next i
End Sub

Private Sub btnGenerateReport_Click()

    Dim wsMain As Worksheet
    Dim wsReport As Worksheet
    Dim wbNew As Workbook
    Dim lastRow As Long
    Dim selectedOption As String
    Dim selectedDomains As Object
    Dim selectedRiskPriorities As Object
    Dim i As Long, j As Long
    Dim reportRow As Long
    Dim startCol As Long, endCol As Long
    Dim headerRange As Range
    Dim optionFound As Boolean
    Dim newFileName As String

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

    ' Create dictionaries for selected filters
    Set selectedDomains = CreateObject("Scripting.Dictionary")
    Set selectedRiskPriorities = CreateObject("Scripting.Dictionary")

    wsReport.Cells.Clear ' Clear the Report Sheet

    ' Get selected combo box value (Country or Standard)
    selectedOption = Me.cmbOptions.Value

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

    ' Add selected domains to the dictionary
    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

    ' Add selected risk priorities to the dictionary
    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

    optionFound = False

    If Me.optCountry.Value Then
        ' Handle Country-specific logic
        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
        optionFound = True
    ElseIf Me.optStandard.Value Then
        ' Handle Standard-specific logic
        For j = 22 To 29 ' Columns V to AC
            If wsMain.Cells(2, j).Value = selectedOption Or wsMain.Cells(3, j).Value = selectedOption Then
                startCol = j
                endCol = j
                optionFound = True
                Exit For
            End If
        Next j

        If Not optionFound Then
            MsgBox "Standard not found in the headers!", vbExclamation
            Exit Sub
        End If
    End If

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

    ' Copy selected Country or Standard-specific 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))

    ' Generate the report based on selected filters
    lastRow = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row
    reportRow = 4 ' Start writing data from row 4 in the Report Sheet

    For i = 4 To lastRow
        ' Check if the row matches the selected filters
        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

            ' 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 Country or Standard
            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(3, 54)).Copy _
                Destination:=wsReport.Cells(reportRow, 5 + (endCol - startCol + 1))

            reportRow = reportRow + 1
        End If
    Next i

    ' Now, call the function to remove rows with all blank country columns
    Call FilterAndRemoveBlankRows(wsReport)

    ' Create a new workbook and copy the report
    Set wbNew = Application.Workbooks.Add
    wsReport.Copy Before:=wbNew.Sheets(1)

    ' Name the new worksheet appropriately
    wbNew.Sheets(1).Name = "Generated Report"

    ' Prompt user for file name
    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 ' Close the new workbook if not saved
    Unload Me

End Sub

Private Sub FilterAndRemoveBlankRows(wsReport As Worksheet)
    Dim lastRow As Long
    Dim i As Long
    Dim countryColumnRange As Range
    Dim isRowEmpty As Boolean
    Dim selectedCountry As String
    Dim countryColumns As Variant
    
    ' Get the selected country from the dropdown
    selectedCountry = Me.cmbOptions.Value ' Assuming cmbOptions contains the selected country
    
    ' Define country-specific column ranges based on the selected country
    If selectedCountry = "UAE" Then
        countryColumns = Array(5, 6, 7, 8) ' Columns E:H for UAE
    ElseIf selectedCountry = "Hong Kong" Then
        countryColumns = Array(9, 9) ' Column I for Hong Kong
    ElseIf selectedCountry = "India" Then
        countryColumns = Array(10, 11) ' Columns J:K for India
    ElseIf selectedCountry = "Kuwait" Then
        countryColumns = Array(12, 12) ' Column L for Kuwait
    ElseIf selectedCountry = "Qatar" Then
        countryColumns = Array(13, 13) ' Column M for Qatar
    ElseIf selectedCountry = "Oman" Then
        countryColumns = Array(14, 15) ' Columns N:O for Oman
    ElseIf selectedCountry = "Bahrain" Then
        countryColumns = Array(16, 17) ' Columns P:Q for Bahrain
    ElseIf selectedCountry = "Pakistan" Then
        countryColumns = Array(18, 19) ' Columns R:S for Pakistan
    ElseIf selectedCountry = "USA" Then
        countryColumns = Array(20, 21) ' Columns T:U for USA
    End If

    ' Find the last row in the report sheet
    lastRow = wsReport.Cells(wsReport.Rows.Count, 1).End(xlUp).Row

    ' Loop through each row from the bottom to the top
    For i = lastRow To 4 Step -1 ' Start from row 4 (assuming header is in row 3)
        isRowEmpty = True ' Assume row is empty unless proven otherwise
        
        ' Check all columns for the selected country
        For Each col In countryColumns
            Set countryColumnRange = wsReport.Range(wsReport.Cells(i, col), wsReport.Cells(i, col))
            If WorksheetFunction.CountA(countryColumnRange) > 0 Then
                isRowEmpty = False ' If any country column has content, keep the row
                Exit For
            End If
        Next col
        
        ' If all country columns are empty, delete the row
        If isRowEmpty Then
            wsReport.Rows(i).Delete
        End If
    Next i
End Sub
Leave a Comment