asked on

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)

Rob Henson

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

shieldsco

ASKER

Yes there are multiple sheets and the formulas will be in columns J, K and all rows that contain data.

Rodney Endriga

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.

shieldsco

ASKER

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 Endriga

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.

shieldsco

ASKER

I'm using 2010 and have 150 sheets

Rodney Endriga

Do you have an existing Worksheet with the name MASTER or is there no sheet named 'MASTER' and you need it created?

shieldsco

ASKER

It's putting the vlookup formula on the table_array not the MASTER

Rodney Endriga

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?

shieldsco

ASKER

it should be applying the VLOOKUP formula starting with the 2nd row on the MASTER only in Columns J, K, and L.

Rodney Endriga

Ok, now I understand better, let me adjust the code and get back to you. Thank you for the clarification.

shieldsco

ASKER

Thanks

Rodney Endriga

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

shieldsco

ASKER

Find the file attahced
SOD-Conflict-Review-Mock-Up.xlsm

Rodney Endriga

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?

shieldsco

ASKER

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

shieldsco

ASKER

Anybody have any other thoughts

shieldsco

ASKER

If the #N/A in the "ERP_USER_NAME" column is a problem I can make sure there is always a valid value

shieldsco

ASKER

Rodney can you handle this task?

Rob Henson

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.

shieldsco

ASKER

ok thanks Rob...

Rodney Endriga

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 Henson

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 Henson

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.

aikimark

@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?

aikimark

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?

aikimark

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.

aikimark

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

shieldsco

ASKER

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)"

ASKER CERTIFIED SOLUTION

aikimark

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

aikimark

It is possible to programmatically detect the #NA conditions.

shieldsco

ASKER

Thanks