Untitled
unknown
plain_text
9 months ago
6.4 kB
3
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 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
Editor is loading...
Leave a Comment