Untitled
' This is triggered when the UserForm is initialized Private Sub UserForm_Initialize() Call PopulateOptions End Sub ' These handle Country/Standard option selection Private Sub optCountry_Click() Call PopulateOptions End Sub Private Sub optStandard_Click() Call PopulateOptions End Sub ' Populate the ComboBox and filters based on selection Private Sub PopulateOptions() Dim ws As Worksheet Dim i As Long Dim uniqueDomains As Object Dim uniqueRiskPriorities As Object Dim cellValue As String ' Set worksheet and dictionaries 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 countries or standards If Me.optCountry.Value Then ' Populate 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 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 Domain list (Column A) For i = 4 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 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 Risk Priority list (Column AR) For i = 4 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row cellValue = ws.Cells(i, 44).Value ' Column AR If cellValue <> "" And Not uniqueRiskPriorities.exists(cellValue) Then uniqueRiskPriorities.Add cellValue, True Me.lstRiskPriority.AddItem cellValue End If Next i End Sub ' Generate the report based on the selected filters Private Sub btnGenerateReport_Click() Dim wsMain As Worksheet, wsReport As Worksheet Dim wbNew As Workbook Dim selectedOption As String, newFileName As String Dim selectedDomains As Object, selectedRiskPriorities As Object Dim startCol As Long, endCol As Long Dim lastRow As Long, reportRow As Long Dim i As Long, j As Long Dim headerRange As Range, optionFound As Boolean Dim rowHasData As Boolean ' Initialize variables 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 the Report Sheet ' Get selected option selectedOption = Me.cmbOptions.Value If selectedOption = "" Then MsgBox "Please select an option from the dropdown.", vbExclamation Exit Sub End If ' Gather selected domains and risk priorities 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 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 ' Determine the column range for the selected option If Me.optCountry.Value Then ' Handle country selection 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 selection For j = 22 To 29 ' Columns V to AC If wsMain.Cells(2, j).Value = selectedOption Then startCol = j endCol = j optionFound = True Exit For End If Next j If Not optionFound Then MsgBox "Standard not found!", vbExclamation Exit Sub End If End If ' Copy headers wsMain.Range("A1:D3").Copy Destination:=wsReport.Range("A1") wsMain.Range(wsMain.Cells(1, startCol), wsMain.Cells(3, endCol)).Copy _ Destination:=wsReport.Cells(1, 5) wsMain.Range(wsMain.Cells(1, 30), wsMain.Cells(3, 54)).Copy _ Destination:=wsReport.Cells(1, 5 + (endCol - startCol + 1)) ' Filter and copy rows lastRow = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row reportRow = 4 ' Start writing data from row 4 For i = 4 To lastRow rowHasData = False ' For countries: Check if at least one cell in the range has data If Me.optCountry.Value Then For j = startCol To endCol If Trim(wsMain.Cells(i, j).Value) <> "" Then rowHasData = True Exit For End If Next j End If ' For standards: Check if the selected cell is not empty If Me.optStandard.Value Then If Trim(wsMain.Cells(i, startCol).Value) <> "" Then rowHasData = True End If End If ' Check domain and risk priority filters If rowHasData And (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 row data wsMain.Range(wsMain.Cells(i, 1), wsMain.Cells(i, 4)).Copy _ Destination:=wsReport.Cells(reportRow, 1) wsMain.Range(wsMain.Cells(i, startCol), wsMain.Cells(i, endCol)).Copy _ Destination:=wsReport.Cells(reportRow, 5) wsMain.Range(wsMain.Cells(i, 30), wsMain.Cells(i, 54)).Copy _ Destination:=wsReport.Cells(reportRow, 5 + (endCol - startCol + 1)) reportRow = reportRow + 1 End If Next i ' Create and save the report Set wbNew = Application.Workbooks.Add wsReport.Copy Before:=wbNew.Sheets(1) wbNew.Sheets(1).Name = "Generated Report" 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
Leave a Comment