Untitled
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 lastRow As Long Dim selectedOption As String Dim startCol As Long, endCol As Long Dim i As Long, reportRow As Long Dim optionFound As Boolean Dim headerRange As Range Dim wbNew As Workbook Dim newFileName As String ' Set worksheets Set wsMain = ThisWorkbook.Sheets("Integrated Control sheet") Set wsReport = ThisWorkbook.Sheets("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 optionFound = False ' Step 1: Handle Country-specific logic If Me.optCountry.Value Then ' Find the selected country in the header row (Row 2) 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 ' Step 2: Perform Deletion for the selected country range ' Loop through each row and check if both columns are empty in the specified range for the country For i = wsMain.Cells(wsMain.Rows.Count, 1).End(xlUp).Row To 4 Step -1 If wsMain.Cells(i, startCol).Value = "" And wsMain.Cells(i, endCol).Value = "" Then wsMain.Rows(i).Delete End If Next i End If ' If country-specific logic didn't find the country, exit If Not optionFound Then MsgBox "Country not found in the headers!", vbExclamation Exit Sub End If ' Step 3: Prepare the Report Sheet for data copy wsReport.Cells.Clear ' Clear the Report Sheet ' Copy the relevant headers for the selected country 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) ' Copy additional headers from columns V to BB (preserved) wsMain.Range("V1:BB3").Copy Destination:=wsReport.Cells(1, 5 + (endCol - startCol + 1)) ' Step 4: Copy data to the Report Sheet based on filtered rows 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 has valid data (columns are not empty for the selected country) If wsMain.Cells(i, startCol).Value <> "" Or wsMain.Cells(i, endCol).Value <> "" Then 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, 22), wsMain.Cells(i, 54)).Copy Destination:=wsReport.Cells(reportRow, 5 + (endCol - startCol + 1)) reportRow = reportRow + 1 End If Next i ' Step 5: Create a new workbook and copy the report Set wbNew = Application.Workbooks.Add wsReport.Copy Before:=wbNew.Sheets(1) 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 ' Step 6: Delete the helper column (after report generation) wsReport.Columns(5).Delete ' Optionally, confirm the report is copied to "Report Sheet" in the original workbook MsgBox "Report has also been copied to the 'Report Sheet' in the current workbook." ' Unload the form Unload Me End Sub
Leave a Comment