Perform Code on all selected Workbooks

[helpexcel]

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.

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

 

[rollis13]

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]

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]

Well, yes, the ListBox needs to be dynamic for sure but without analyzing the entire project I can't be more precise.