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 Dim uniqueRiskPriorities As Object Dim cellValue As String ' Initialize variables 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 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 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) 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 unique Risk Priorities (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 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 Dim headerRange As Range, optionFound 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 combo box value selectedOption = Me.cmbOptions.Value If selectedOption = "" Then MsgBox "Please select an option from the dropdown.", vbExclamation Exit Sub End If ' Add selected domains and risk priorities to dictionaries 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 ' Handle Country selection If Me.optCountry.Value Then 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 End If ' Handle Standard selection If Me.optStandard.Value Then For i = 22 To 29 ' Columns V to AC If wsMain.Cells(2, i).Value = selectedOption Then startCol = i endCol = i optionFound = True Exit For End If Next i 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 If Me.optCountry.Value Then ' For Country: Delete rows with blanks in selected columns If Application.WorksheetFunction.CountBlank(wsMain.Range(wsMain.Cells(i, startCol), wsMain.Cells(i, endCol))) = 0 Then wsMain.Rows(i).Copy Destination:=wsReport.Rows(reportRow) reportRow = reportRow + 1 End If ElseIf Me.optStandard.Value Then ' For Standard: Keep rows with data in selected column If wsMain.Cells(i, startCol).Value <> "" Then wsMain.Rows(i).Copy Destination:=wsReport.Rows(reportRow) reportRow = reportRow + 1 End If End If Next i ' Create and save a new workbook 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 ' Close if not saved Unload Me End Sub
Leave a Comment