Untitled
user_1123194
plain_text
9 months ago
4.2 kB
6
Indexable
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