Is there a way to make this VBA code such that it should make dynamic workbook selection

Question

#In this code I want to make workbook speaker.xlsx dynamic such that this code should work even if the workbook name is changed.

Sub test()
Dim vendor As Variant, item As Variant
Dim n As Variant, n1 As Variant, cat As Variant, cat1 As Variant
Dim n2 As Variant, n3 As Variant, data As Variant, data1 As Variant


n = Workbooks("speaker.xlsx").Sheets("speaker").Cells(Rows.Count, 1).End(xlUp).Row
n1 = Workbooks("LPD_Data.xlsx").Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

cat = Workbooks("speaker.xlsx").Sheets("speaker").Range("A2").Value
Workbooks("speaker.xlsx").Sheets.Add.Name = "Output"

    For i = 2 To n1
    
        cat1 = Workbooks("LPD_Data.xlsx").Sheets("Sheet1").Range("A" & i).Value

        If cat = cat1 Then
    
        Exit For
        End If
    Next i

    n2 = Workbooks("LPD_Data.xlsx").Sheets("Sheet1").Cells(i, Columns.Count).End(xlToLeft).Column
    x = 4
    For j = 2 To n2
    x = x + 1
    Workbooks("speaker.xlsx").Sheets("Output").Cells(1, x).Value = Workbooks("LPD_Data.xlsx").Sheets("Sheet1").Cells(i, j).Value
    Next j

    n3 = Workbooks("speaker.xlsx").Sheets("speaker").Cells(1, Columns.Count).End(xlToLeft).Column
    n2 = n2 + 3
    Workbooks("speaker.xlsx").Sheets("Output").Range("A1").Value = "Category"
    Workbooks("speaker.xlsx").Sheets("Output").Range("B1").Value = "Item"
    Workbooks("speaker.xlsx").Sheets("Output").Range("C1").Value = "Vendor(s)"
    Workbooks("speaker.xlsx").Sheets("Output").Range("C1").Value = "Model"
    Workbooks("speaker.xlsx").Sheets("Output").Range("C1").Value = "Barcode"
    For k = 1 To n2
        data = Workbooks("speaker.xlsx").Sheets("Output").Cells(1, k).Value
        data = Trim(data)
        For m = 1 To n3
            data1 = Workbooks("speaker.xlsx").Sheets("speaker").Cells(1, m).Value
            data1 = Trim(data1)
            If data = data1 Then
            Workbooks("speaker.xlsx").Sheets("speaker").Activate
            Workbooks("speaker.xlsx").Sheets("speaker").Cells(2, m).Select
            Workbooks("speaker.xlsx").Sheets("speaker").Range(Selection, Selection.End(xlDown)).Copy
            Workbooks("speaker.xlsx").Sheets("Output").Activate
            Workbooks("speaker.xlsx").Sheets("Output").Cells(2, k).Select
            ActiveSheet.Paste
            Exit For
            End If
        Next m
    Next k
End Sub

create a sub that takes the workbookname as a parameter - then use this parameter within the sub — Ike, Mar 23 '22 at 07:23
Check [here](https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/sub-statement) to see how to add an argument to a sub. And [this](https://stackoverflow.com/questions/30833126/excel-vba-open-workbook) may help about how to make the workbook dynamic. — Foxfire And Burns And Burns, Mar 23 '22 at 08:39
You have just written to `E1:SomeColumn1`. A little bit later you are writing to `A1:B1` and three times to `C1`. Maybe the initial `x` should be `5`, and the two `C1`s should be `D1` and `E1`. Also, first, you use `2 To n2`, later you use `1 To n2`. Please do clarify. You can [edit your post](https://stackoverflow.com/posts/71582489/edit) at any time. — VBasic2008, Mar 23 '22 at 08:46

VBasic2008 · Answer 1 · 2022-03-23T09:17:36.720

Identify (Reference) a 3rd Open Workbook

This will work if there are only the three involved workbooks open:
- ThisWorkbook, the workbook containing this code,
- LPD_Data.xlsx, the source workbook,
- and the destination workbook (whatever it is called).
After copying the 'found category row', I maybe got lost a little bit (see the '*** and '***** identifiers). I'm sure you can fix it. Identifying the 3rd workbook is the important part anyway.

Option Explicit

Sub test()
    
    Dim twb As Workbook: Set twb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source worksheet.
    
    Dim swb As Workbook: Set swb = Workbooks("LPD_Data.xlsx")
    Dim sws As Worksheet: Set sws = swb.Worsheets("Sheet1")
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, 1).End(xlUp).Row
    
    ' Identify the destination workbook.
    
    Dim Exclusions() As String: ReDim Exclusions(0 To 1)
    Exclusions(1) = twb.Name
    Exclusions(2) = swb.Name
    
    Dim dwb As Workbook
    Dim dwbFound As Boolean
    
    For Each dwb In Workbooks
        If IsError(Application.Match(dwb.Name, Exclusions, 0)) Then
            dwbFound = True
            Exit For
        End If
    Next dwb
    
    If dwbFound = False Then
        MsgBox "The destination workbook is not open.", vbExclamation
        Exit Sub
    End If
    
    ' Reference destination worksheets.
    
    Dim dwsSpeaker As Worksheet: Set dwsSpeaker = dwb.Worksheets("Speaker")
    Dim dslRow As Long
    dslRow = dwsSpeaker.Cells(dwsSpeaker.Rows.Count, 1).End(xlUp).Row
    Dim dslCol As Long
    dslCol = dwsSpeaker.Cells(1, dwsSpeaker.Columns.Count).End(xlToLeft).Column
    
    Dim dwsOutput As Worksheet
    Set dwsOutput = dwb.Worksheets.Add(Before:=dwb.Sheets(1)) ' first
    ' or last:
    'Set dwsOutPut = dwb.Worksheets.Add(After:=dwb.Sheets(dwb.Sheets.Count))
    dwsOutput.Name = "Output"
    
    Dim dCat As Variant: dCat = dwsSpeaker.Range("A2").Value
    Dim sCat As Variant
    Dim sr As Long
    
    ' Find dCat in the source worksheet and write the source row
    ' to the destination output first row.
    
    For sr = 2 To slRow
        sCat = sws.Range("A" & sr).Value
        If dCat = sCat Then
            Exit For
        End If
    Next sr

    Dim slCol As Long
    slCol = sws.Cells(sr, sws.Columns.Count).End(xlToLeft).Column
    
    Dim dc As Long: dc = 4 ' ***
    Dim sc As Long
    
    For sc = 2 To slCol '*****
        dc = dc + 1
        dwsOutput.Cells(1, dc).Value = sws.Cells(sr, sc).Value '*** maybe
    Next sc
    
    Dim dataOutput As Variant
    Dim dataSpeaker As Variant
    
    dwsOutput.Range("A1:E1").Value _
        = Array("Category", "Item", "Vendor", "Model", "Barcode") '***
    
    slCol = slCol + 3
    
    For sc = 1 To slCol ' *****
        dataOutput = Trim(dwsOutput.Cells(1, sc).Value)
        For dc = 1 To dslCol
            dataSpeaker = Trim(dwsSpeaker.Cells(1, dc).Value)
            If dataOutput = dataSpeaker Then
                With dwsSpeaker
                    .Range(.Cells(2, dc), .Cells(2, dc).End(xlDown)) _
                        .Copy dwsOutput(2, sc)
                End With
                Exit For
            End If
        Next dc
    Next sc

    MsgBox "Data copied."

End Sub

Is there a way to make this VBA code such that it should make dynamic workbook selection

1 Answers1

Identify (Reference) a 3rd Open Workbook