Code is not picking the data from the Source table

[Suavesav]

This is the code I wrote post R&D and using Chatgpt. The code is creating blank sheets but now the file I need with the data. Please help..

Sub GenerateDSR()
    Dim wsSource As Worksheet
    Dim wsReference As Worksheet
    Dim wsDest As Worksheet

    ' Set references to the source, reference, and destination sheets
    Set wsSource = ThisWorkbook.Sheets("Source")
    Set wsReference = ThisWorkbook.Sheets("Reference")

    ' Get the selected customer name from the drop-down list in cell B2
    Dim customerName As String
    customerName = wsSource.Range("B2").Value

    ' Find the customer name in the reference sheet
    Dim customerRange As Range
    Set customerRange = wsReference.Range("B1:BX1").Find(customerName, LookIn:=xlValues, LookAt:=xlWhole)

    ' Check if the customer name is found
    If customerRange Is Nothing Then
        MsgBox "Customer name '" & customerName & "' not found in the reference sheet.", vbExclamation
        Exit Sub
    End If

    ' Determine the column number of the customer name in the reference sheet
    Dim customerCol As Long
    customerCol = customerRange.Column

    ' Get the headers for the current customer from the reference sheet
    Dim headerRange As Range
    Set headerRange = wsReference.Range(wsReference.Cells(2, customerCol), wsReference.Cells(wsReference.Rows.Count, customerCol).End(xlUp))

    ' Create a new destination sheet for the customer report
    Set wsDest = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsDest.Name = Left(customerName, 31) & " DSR"

    ' Copy the headers to the destination sheet
    headerRange.Copy wsDest.Cells(1, 1)

    ' Find the last row in the source sheet
    Dim lastRow As Long
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row

    ' Loop through the source data and copy relevant columns to the destination sheet
    Dim srcRow As Long
    Dim destRow As Long
    destRow = 2 ' Start copying from the second row in the destination sheet
    For srcRow = 4 To lastRow ' Start from the fourth row in the source sheet
        If wsSource.Cells(srcRow, 6).Value = customerName Then ' Check if the customer name matches
            Dim destColumn As Long
            destColumn = 1
            For Each headerCell In headerRange
                Dim headerRow As Range
                Set headerRow = wsSource.Rows(3).Find(headerCell.Value, LookIn:=xlValues, LookAt:=xlWhole)
                If Not headerRow Is Nothing Then
                    wsDest.Cells(destRow, destColumn).Value = wsSource.Cells(srcRow, headerRow.Column).Value
                End If
                destColumn = destColumn + 1
            Next headerCell
            destRow = destRow + 1
        End If
    Next srcRow

    ' Autofit columns in the destination sheet
    wsDest.UsedRange.Columns.AutoFit

    ' Clear the selection in the source sheet
    wsSource.Select

    MsgBox "DSR generated for customer: " & customerName, vbInformation
End Sub

 

[RoryA]

It shouldn't be possible for that code to create a completely blank sheet.

 

[Suavesav]

It shouldn't be possible for that code to create a completely blank sheet.

It is creating a sheet and naming it "DSR". There is no content inside.

 

[RoryA]

There must be something in the sheet because the headerRange range is always copied to it.