Loop through all workseets in an Excel workbook and create VLookups using VBA

I would like to use vba to loop through all the worksheets in an Excel workbook to create vlookup formulas on a master sheet. The 3 columns on the master sheet are J, K and L and formulas are below  Can you provide code that might accomplish this. Thanks

Column (J) Conflict is Justified? (Y/N)      Column(K) Justification      Column(L) Mitigating Controls for Conflict
=VLOOKUP($A:$A,Adrian_Luster!$A:$L,10,FALSE)      =VLOOKUP($A:$A,Adrian_Luster!$A:$L,11,FALSE)      =VLOOKUP($A:$A,Adrian_Luster!$A:$L,12,FALSE)
shieldscoAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rob HensonFinance AnalystCommented:
I assume you mean there are sheets other than Adrian_Luster in the workbook and you want the equivalent formulas for each of the sheets?

Do you want them as additional rows or columns?

The formula is slightly wrong as well, the first parameter should be a single cell, not a range:

=VLOOKUP($A2,Adrian_Luster!$A:$L,10,FALSE)

Thanks
Rob H
shieldscoAuthor Commented:
Yes there are multiple sheets and the formulas will be in columns J, K and all rows that contain data.
Rodney EndrigaData AnalystCommented:
This code will go through all the sheets in the ActiveWorkbook and place the VLOOKUP formula in Cols (J, K, L):
Sub EE_AllWorksheets()
Dim l As Long, shtName As String, chk As Boolean, ws As Worksheet
Application.ScreenUpdating = False
shtName = UCase("master")
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = shtName Then chk = True: Exit For
Next ws
If chk = False Then
    Sheets.Add(Before:=Sheets(1)).Name = shtName
End If
For Each ws In ActiveWorkbook.Worksheets
    ws.Activate
    Cells(1, 10).FormulaR1C1 = "=VLOOKUP(R[1]C1," & ws.Name & "!C1:C12,10,FALSE)"
    Cells(1, 11).FormulaR1C1 = "=VLOOKUP(R[1]C1," & ws.Name & "!C1:C12,11,FALSE)"
    Cells(1, 12).FormulaR1C1 = "=VLOOKUP(R[1]C1," & ws.Name & "!C1:C12,12,FALSE)"
Next ws
Application.ScreenUpdating = True
End Sub

Open in new window

It will search for a sheet named 'MASTER'.
If it finds the sheet, it will place the VLOOKUP formula in the proper columns.
If it does NOT find the sheet, it will create a new sheet named 'MASTER' & place the VLOOKUP formula in the proper columns.

This could be a starting point on what you are looking for.
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

shieldscoAuthor Commented:
Getting Run-Time Error :1004
Cannot rename a sheet the same name as another, a referenced object library or a workbook referenced by visual basic



Error on line:
    Sheets.Add(Before:=Sheets(1)).Name = shtName
Rodney EndrigaData AnalystCommented:
Not sure what the error is.

I have run the code on a Workbook with a sheet named 'MASTER' and 6 other sheets (no spaces/special characters) &
I have run the code on a Workbook without a sheet named 'MASTER' and 6 other sheets (no spaces/special characters).

I did not receive any error messages and the code ran successfully. I am using Excel 2007.
shieldscoAuthor Commented:
I'm using 2010 and have 150 sheets
Rodney EndrigaData AnalystCommented:
Do you have an existing Worksheet with the name MASTER or is there no sheet named 'MASTER' and you need it created?
shieldscoAuthor Commented:
It's putting the vlookup formula  on the table_array not the MASTER
Rodney EndrigaData AnalystCommented:
The code is applying the VLOOKUP formula to the 1st row of each sheet in (Columns J, K, and L) in the workbook.

Did you want it in a different location?
Would you mind posting a sample file to work with? Initial file setup, and then Final Results file?
shieldscoAuthor Commented:
it should be applying the VLOOKUP formula starting with the 2nd row on the MASTER  only in Columns J, K, and L.
Rodney EndrigaData AnalystCommented:
Ok, now I understand better, let me adjust the code and get back to you. Thank you for the clarification.
shieldscoAuthor Commented:
Thanks
Rodney EndrigaData AnalystCommented:
Can you try this code & let me know if this is more along the lines of what you are looking for:
Sub EE_AllWorksheets()
Dim l As Long, shtName As String, chk As Boolean, ws As Worksheet
Application.ScreenUpdating = False
shtName = UCase("master")
z = 1
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = shtName Then chk = True: Exit For
Next ws
If chk = False Then
    Sheets.Add(Before:=Sheets(1)).Name = shtName
End If
For Each ws In ActiveWorkbook.Worksheets
    z = z + 1
    Sheets(shtName).Activate
    Cells(z, 10).FormulaR1C1 = "=VLOOKUP(RC1," & ws.Name & "!C1:C12,10,FALSE)"
    Cells(z, 11).FormulaR1C1 = "=VLOOKUP(RC1," & ws.Name & "!C1:C12,11,FALSE)"
    Cells(z, 12).FormulaR1C1 = "=VLOOKUP(RC1," & ws.Name & "!C1:C12,12,FALSE)"
Next ws
Application.ScreenUpdating = True
End Sub

Open in new window

shieldscoAuthor Commented:
Find the file attahced
SOD-Conflict-Review-Mock-Up.xlsm
Rodney EndrigaData AnalystCommented:
Thank you for the sample file.

Does the "ERP_USER_NAME" always match up to the sheets in your workbook?
Also, is the #N/A in the "ERP_USER_NAME" column mean there is no valid employee for that ID?
shieldscoAuthor Commented:
Yes to both but the lookup key is ID.. the ID in MASTER is contained on the individual sheets that's why its the lookup..... it's the unique column
shieldscoAuthor Commented:
Anybody have any other thoughts
shieldscoAuthor Commented:
If the #N/A in the "ERP_USER_NAME" column is  a problem I can make sure there is always a valid value
shieldscoAuthor Commented:
Rodney can you handle this task?
Rob HensonFinance AnalystCommented:
Shieldsco - I do have an idea how you may be able to do this but have been tied up at work. I will try and look at home later.
shieldscoAuthor Commented:
ok thanks Rob...
Rodney EndrigaData AnalystCommented:
Sorry shieldsco. Real work got in the way. I have some code using the sample file you provided, but it is not processing at names with a '-' (hyphen) in it. For example, Karen_Eilola-Miller, Rhonda_Belser-Davis, Soneata_Rivers-Lewis, & Starlette_Gaskin-McDaniel. When I removed the (hyphen), the macro worked all the up to the #N/A. When I removed the #N/A, it processed successfully.

Also, I changed your data table to just a normal range of data (in your sample file).
So I have not yet come up with a full proof method.
Rob HensonFinance AnalystCommented:
Formula for column J:

=VLOOKUP($A2,INDIRECT([@[ERP_USER_NAME]]&"!$A$1:$M$100"),10,FALSE)

Copied down the column it will change the range/sheet it looks at based on the name in ERP_USER_NAME field.

Change the 10 to 11 and 12 for columns K and L.

This assumes you already the necessary rows for all sheets in MASTER
Rob HensonFinance AnalystCommented:
In addition, the size of the file could be due to excessive Used Area on the Named tabs.

On each tab, press Ctrl + End and the cursor should just go to the bottom right of column L but it goes to column XFD, several thousand columns too many.  If you select these columns and delete them, remove not just clear, and then save it will reset the Used Area.

Also, just realised looking at other sheets, you will need to adjust the $A$1:$M$100 to allow for more than 100 rows on each sheet.
aikimarkCommented:
@shieldsco

Are you looking up data to place into the MASTER worksheet cells or looking up data in the MASTER worksheet cells to place into the workers' worksheet cells?
aikimarkCommented:
If you are updating the master, it would look something like this:
Sub Q_28643806()
    'update Master
    Dim wks As Worksheet
    Dim wksMaster As Worksheet
    Dim rng As Range
    Dim dicLastRow As Object
    Set dicLastRow = CreateObject("scripting.dictionary")
    For Each wks In Worksheets
        dicLastRow(wks.Name) = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
    Next
    Set wksMaster = Worksheets("Master")
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    For Each rng In wksMaster.Range(wksMaster.Range("A2"), wksMaster.Range("A2").End(xlDown))
        rng.Cells(1, 10).FormulaR1C1 = "=VLOOKUP(rc[-9],'" & rng.Cells(1, 3).Value & "'!r2c1:r" & dicLastRow(rng.Cells(1, 3).Value) & "c12,10,True)"
        rng.Cells(1, 11).FormulaR1C1 = "=VLOOKUP(rc[-10],'" & rng.Cells(1, 3).Value & "'!r2c1:r" & dicLastRow(rng.Cells(1, 3).Value) & "c12,11,True)"
        rng.Cells(1, 12).FormulaR1C1 = "=VLOOKUP(rc[-11],'" & rng.Cells(1, 3).Value & "'!r2c1:r" & dicLastRow(rng.Cells(1, 3).Value) & "c12,12,True)"
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Open in new window


================
Do you need to have a live/volatile formula like vlookup or are you only interested in populating the cells with the data?
aikimarkCommented:
If you are moving data from the Master to the workers, try this:
Sub Q_28643806_UpdateWorkers()
    'update workers' sheets
    Dim wks As Worksheet
    Dim wksMaster As Worksheet
    Dim rng As Range
    Dim dicLastRow As Object
    Dim dicMasterRange As Object
    Dim vItem As Variant
    
    Set dicLastRow = CreateObject("scripting.dictionary")
    Set dicMasterRange = CreateObject("scripting.dictionary")
    
    For Each wks In Worksheets
        dicLastRow(wks.Name) = 1
    Next
    dicLastRow.Remove "MASTER"
    
    Set wksMaster = Worksheets("MASTER")
    
    For Each vItem In dicLastRow
        dicMasterRange(vItem) = Array(wksMaster.Range("c:c").Find(what:=vItem).Row, wksMaster.Range("c:c").Find(what:=vItem, searchdirection:=xlPrevious).Row)
    Next
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    For Each wks In Worksheets
        If dicLastRow.exists(wks.Name) Then
            For Each rng In wks.Range(wks.Range("A2"), wks.Cells(wks.Rows.Count, 1).End(xlUp))
                If IsNumeric(rng.Value) Then
                    rng.Cells(1, 10).FormulaR1C1 = "=VLOOKUP(rc[-9],'MASTER'!r" & dicMasterRange(wks.Name)(0) & "c1:r" & dicMasterRange(wks.Name)(1) & "c12,10,True)"
                    rng.Cells(1, 11).FormulaR1C1 = "=VLOOKUP(rc[-10],'MASTER'!r" & dicMasterRange(wks.Name)(0) & "c1:r" & dicMasterRange(wks.Name)(1) & "c12,11,True)"
                    rng.Cells(1, 12).FormulaR1C1 = "=VLOOKUP(rc[-11],'MASTER'!r" & dicMasterRange(wks.Name)(0) & "c1:r" & dicMasterRange(wks.Name)(1) & "c12,12,True)"
                End If
            Next
            
        End If
        
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Open in new window


================
However, you could also run code to move the values instead of creating vlookup formulas.  Your worksheet would open quicker and run faster.
aikimarkCommented:
Here is an example of a direct values transfer.  In this case it updates the values in the Master worksheet.
Option Explicit


Sub Q_28643806_UpdateMasterValues()
    'update Master
    Dim wks As Worksheet
    Dim wksMaster As Worksheet
    Dim wksWorker As Worksheet
    Dim rng As Range
    Dim rngFind As Range
    Dim dicLastRow As Object
    Set dicLastRow = CreateObject("scripting.dictionary")
    For Each wks In Worksheets
        dicLastRow(wks.Name) = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
    Next
    Set wksMaster = Worksheets("Master")
    Set wksWorker = Worksheets("Master")
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    For Each rng In wksMaster.Range(wksMaster.Range("A2"), wksMaster.Range("A2").End(xlDown))
        Do  '<<<GROUP
            If wksWorker.Name <> rng.Cells(1, 3).Value Then
                If dicLastRow.exists(rng.Cells(1, 3).Value) Then
                    Set wksWorker = Worksheets(rng.Cells(1, 3).Value)
                Else
                    Exit Do
                End If
            End If
            Set rngFind = wksWorker.Range(wksWorker.Cells(1, 1), wksWorker.Cells(dicLastRow(wksWorker.Name), 1)).Find(rng.Value)
            If rngFind Is Nothing Then
            Else
                If RangeValuesAreEqual(wksMaster.Range(rng.Cells(1, 10), rng.Cells(1, 12)), _
                                       wksWorker.Range(rngFind.Cells(1, 10), rngFind.Cells(1, 12))) Then
                Else
                    wksMaster.Range(rng.Cells(1, 10), rng.Cells(1, 12)).Value = _
                                wksWorker.Range(rngFind.Cells(1, 10), rngFind.Cells(1, 12)).Value
                End If
            End If
        Loop While False   '>>>GROUP
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Function RangeValuesAreEqual(parmTgt As Range, parmSrc As Range) As Boolean
    'assume same shaped and sized regions passed
    Dim vTgt As Variant
    Dim vSrc As Variant
    Dim lngRow As Long, lngCol As Long
    vTgt = parmTgt.Value
    vSrc = parmSrc.Value
    RangeValuesAreEqual = True
    For lngRow = 1 To UBound(vTgt, 1)
        For lngCol = 1 To UBound(vTgt, 2)
            If vTgt(lngRow, lngCol) <> vSrc(lngRow, lngCol) Then
                RangeValuesAreEqual = False
                Exit Function
            End If
        Next
    Next
    
End Function

Open in new window

shieldscoAuthor Commented:
Aikimark - runtime error 13 type mismatch on line         rng.Cells(1, 10).FormulaR1C1 = "=VLOOKUP(rc[-9],'" & rng.Cells(1, 3).Value & "'!r2c1:r" & dicLastRow(rng.Cells(1, 3).Value) & "c12,10,True)"
aikimarkCommented:
You have errors in your Master worksheet cells in column C.  In my copy of the worksheet, I cleared those #NA values.  This runs without error.
Sub Q_28643806_UpdateMaster()
    'update Master
    Dim wks As Worksheet
    Dim wksMaster As Worksheet
    Dim rng As Range
    Dim dicLastRow As Object
    Set dicLastRow = CreateObject("scripting.dictionary")
    For Each wks In Worksheets
        dicLastRow(wks.Name) = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
    Next
    Set wksMaster = Worksheets("Master")
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    For Each rng In wksMaster.Range(wksMaster.Range("A2"), wksMaster.Range("A2").End(xlDown))
        If Len(rng.Cells(1, 3).Value) <> 0 Then
            rng.Cells(1, 10).FormulaR1C1 = "=VLOOKUP(rc[-9],'" & rng.Cells(1, 3).Value & "'!r2c1:r" & dicLastRow(rng.Cells(1, 3).Value) & "c12,10,True)"
            rng.Cells(1, 11).FormulaR1C1 = "=VLOOKUP(rc[-10],'" & rng.Cells(1, 3).Value & "'!r2c1:r" & dicLastRow(rng.Cells(1, 3).Value) & "c12,11,True)"
            rng.Cells(1, 12).FormulaR1C1 = "=VLOOKUP(rc[-11],'" & rng.Cells(1, 3).Value & "'!r2c1:r" & dicLastRow(rng.Cells(1, 3).Value) & "c12,12,True)"
        End If
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
aikimarkCommented:
It is possible to programmatically detect the #NA conditions.
shieldscoAuthor Commented:
Thanks
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.