Perform Code on all selected Workbooks

helpexcel

Well-known Member
Joined
Oct 21, 2009
Messages
559
Hi - I have code where I select the workbooks i want to import data from. My problem is that i have code for when I have 1 workbook and code for when I have 2 workbooks. How do i make the code variable so that it know how many workbooks i selected and cycles through each one. The data is arranged the same in all of the workbooks.

VBA Code:
Dim N1 As String, N2 As String
Dim x As Long
    With ListBox1
        For x = 0 To .ListCount - 1
            If .Selected(x) = True Then
                If N2 <> "" Then Exit For
                If N1 = "" Then N1 = .List(x) Else N2 = .List(x)
                .Selected(x) = False
            End If
        Next
    End With
    
Dim wb1, wb2 As Workbook
Dim ws1, ws2, ws3, wsSP As Worksheet
Dim LR, lr2, lr3 As Long
Dim Cl As Range
sName = "Yahoo"
 
   Set wb1 = Workbooks(N1)
   Set wb2 = Workbooks(N2)
          
    Set wsSP = Sheet1
    Set ws1 = Sheet3
    
    Set ws2 = wb1.Sheets(sName)
    Set ws3 = wb2.Sheets(sName)
    
With ws1
    If IsEmpty(.Range("A11")) = True Then
        lr2 = 11
    Else
        lr2 = .Cells(.Rows.Count, "A").End(xlUp).Row
    End If

'    If IsEmpty(.Range("A11")) = False Then
'        .Range("A11:Y" & lr2).ClearContents
'    End If
End With
 
With ws2
    LR = .Cells(.Rows.Count, "C").End(xlUp).Row - 2
    .Range("C11:C" & LR).Copy
    ws1.Range("A11").PasteSpecial xlPasteValues
End With
      
With ws3
    lr3 = .Cells(.Rows.Count, "C").End(xlUp).Row - 2
    .Range("C11:C" & lr3).Copy
    ws1.Range("A" & Rows.Count).End(xlUp).PasteSpecial xlPasteValues
End With

    With CreateObject("scripting.dictionary")
      .CompareMode = 1
        For Each Cl In ws2.Range("C11" & LR)
         .Item(Cl.Value) = Cl.Offset(, 15).Value
        Next Cl
        For Each Cl In ws3.Range("C11" & lr3)
        If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 15).Value
        Next Cl
        For Each Cl In ws1.Range("A11" & lr2)
        If .exists(Cl.Value) Then Cl.Offset(, 13).Value = .Item(Cl.Value)
        Next Cl
        If .Count > 0 Then ws1.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(.Count).Value = Application.Transpose(.keys)
    End With
    
    With CreateObject("scripting.dictionary")
      .CompareMode = 1
        For Each Cl In ws2.Range("C11", ws2.Range("E" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 3).Value
        Next Cl
        For Each Cl In ws3.Range("C11", ws3.Range("E" & Rows.Count).End(xlUp))
        If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 3).Value
        Next Cl
        For Each Cl In ws1.Range("A11", ws1.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 1).Value = .Item(Cl.Value)
         Next Cl
    End With

    With CreateObject("scripting.dictionary")
      .CompareMode = 1
        For Each Cl In ws2.Range("C11", ws2.Range("E" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 14).Value
        Next Cl
        For Each Cl In ws3.Range("C11", ws3.Range("E" & Rows.Count).End(xlUp))
        If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 14).Value
        Next Cl
        For Each Cl In ws1.Range("A11", ws1.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 8).Value = .Item(Cl.Value)
        Next Cl
    End With

    With CreateObject("scripting.dictionary")
      .CompareMode = 1
        For Each Cl In ws2.Range("C11", ws2.Range("E" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 9).Value
        Next Cl
        For Each Cl In ws3.Range("C11", ws3.Range("E" & Rows.Count).End(xlUp))
        If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 9).Value
        Next Cl
        For Each Cl In ws1.Range("A11", ws1.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 6).Value = .Item(Cl.Value)
        Next Cl
    End With

    With CreateObject("scripting.dictionary")
      .CompareMode = 1
        For Each Cl In ws2.Range("C11", ws2.Range("E" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 10).Value
        Next Cl
        For Each Cl In ws3.Range("C11", ws3.Range("E" & Rows.Count).End(xlUp))
        If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 10).Value
        Next Cl
        For Each Cl In ws1.Range("A11", ws1.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 7).Value = .Item(Cl.Value)
        Next Cl
    End With

    With CreateObject("scripting.dictionary")
      .CompareMode = 1
        For Each Cl In ws2.Range("C11", ws2.Range("E" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 16).Value
        Next Cl
        For Each Cl In ws3.Range("C11", ws3.Range("E" & Rows.Count).End(xlUp))
        If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 16).Value
        Next Cl
        For Each Cl In ws1.Range("A11", ws1.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 9).Value = .Item(Cl.Value)
        Next Cl
    End With

    With CreateObject("scripting.dictionary")
      .CompareMode = 1
        For Each Cl In ws2.Range("C11", ws2.Range("E" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 8).Value
        Next Cl
        For Each Cl In ws3.Range("C11", ws3.Range("E" & Rows.Count).End(xlUp))
        If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 8).Value
        Next Cl
        For Each Cl In ws1.Range("A11", ws1.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 4).Value = .Item(Cl.Value)
        Next Cl
    End With

    With CreateObject("scripting.dictionary")
      .CompareMode = 1
        For Each Cl In ws2.Range("C11", ws2.Range("E" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 6).Value
        Next Cl
        For Each Cl In ws3.Range("C11", ws3.Range("E" & Rows.Count).End(xlUp))
        If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 6).Value
        Next Cl
        For Each Cl In ws1.Range("A11", ws1.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 18).Value = .Item(Cl.Value)
        Next Cl
    End With

    With CreateObject("scripting.dictionary")
      .CompareMode = 1
        For Each Cl In ws2.Range("C11", ws2.Range("C" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 7).Value
        Next Cl
        For Each Cl In ws3.Range("C11", ws3.Range("C" & Rows.Count).End(xlUp))
        If Not .exists(Cl.Value) Then .Add Cl.Value, Cl.Offset(, 7).Value
        Next Cl
        For Each Cl In ws1.Range("A11", ws1.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 2).Value = .Item(Cl.Value)
        Next Cl
    End With
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

rollis13

Active Member
Joined
Jul 30, 2012
Messages
426
Office Version
  1. 2016
Platform
  1. Windows
I didn't check your macro to see if it's easy to implement but you could create an array with the names of the workbooks and the with a For/Next cycle the items of the array. Inside the For/Next, with the right reference to the workbook being processed, place your code only once.
 

helpexcel

Well-known Member
Joined
Oct 21, 2009
Messages
559
That make sense, but I'm not sure exactly how to make that work. Assuming i would need to do something along the lines of For Each wb...would i also need to change the Listbox code to allow for unlimited workbooks to be selected?
 

rollis13

Active Member
Joined
Jul 30, 2012
Messages
426
Office Version
  1. 2016
Platform
  1. Windows
Well, yes, the ListBox needs to be dynamic for sure but without analyzing the entire project I can't be more precise.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,016
Messages
5,639,559
Members
417,099
Latest member
duhafnusa4

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top