VLOOKUP Macro -

bjcf33183

New Member
Joined
Dec 11, 2017
Messages
8
Hello,
I have a VLOOKUP macro using the below VBA code. The idea is to take a list of UserID's (on Sheet1/Column A), and populate information for each user (Name, Job Title, etc.) based on a fairly large table array on Sheet2 of the Workbook. My question is, can this be modified in such a way that would eliminate the need to have 9 separate "For..Next" loops?
Each loop is essentially doing a VLOOKUP to pull over the information for 9 different columns (""Name", "Email", "Job Title", "JobID", "Cost Center", "Manager 1", "Manager 2", "Manager 3", "Department"), though it seems like there should be a more efficient way of accomplishing this.

-----------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub VLOOKUP_On_UserID_In_Column_A()
'Worksheet with the LDAP Table Array needs to be named "Sheet2"
'LDAP Table needs to be pasted into Sheet2 prior to running the macro


Dim ws1, ws2 As Worksheet
Dim wb As Workbook
Dim LastRowSheet1 As Long
Dim LastRowSheet2 As Long
Dim TargetRange As Range
Dim i, j As Integer
Dim headers() As Variant


'On Error GoTo MyErrorHandler:


Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")


'Number of rows (with UserID's populated) in Column A on "Sheet1"
LastRowSheet1 = ws1.Cells(Rows.Count, "A").End(xlUp).row


'Number of rows with data in them on "Sheet2" (where the LDAP Information is pasted)
LastRowSheet2 = ws2.Cells(Rows.Count, "A").End(xlUp).row


Set TargetRange = ws2.Range("A1:J" & LastRowSheet2)


headers() = Array("UserID", "Name", "Email", "Job Title", "JobID", "Cost Center", "Manager 1", "Manager 2", "Manager 3", "Department")


With ws1
.Rows(1).Value = "" 'This will clear out row 1
For i = LBound(headers()) To UBound(headers())
.Cells(1, 1 + i).Value = headers(i)
Next i
.Rows(1).Font.Bold = True
End With



For i = 2 To LastRowSheet1
On Error GoTo ErrorHandler1
Worksheets("Sheet1").Cells(i, 2) = Application.WorksheetFunction.VLookup(Worksheets("Sheet1").Cells(i, 1), TargetRange, 2, False)
Next i


For i = 2 To LastRowSheet1
Worksheets("Sheet1").Cells(i, 3) = Application.WorksheetFunction.VLookup(Worksheets("Sheet1").Cells(i, 1), TargetRange, 3, False)
Next i


For i = 2 To LastRowSheet1
Worksheets("Sheet1").Cells(i, 4) = Application.WorksheetFunction.VLookup(Worksheets("Sheet1").Cells(i, 1), TargetRange, 4, False)
Next i


For i = 2 To LastRowSheet1
Worksheets("Sheet1").Cells(i, 5) = Application.WorksheetFunction.VLookup(Worksheets("Sheet1").Cells(i, 1), TargetRange, 5, False)
Next i


For i = 2 To LastRowSheet1
Worksheets("Sheet1").Cells(i, 6) = Application.WorksheetFunction.VLookup(Worksheets("Sheet1").Cells(i, 1), TargetRange, 6, False)
Next i


For i = 2 To LastRowSheet1
Worksheets("Sheet1").Cells(i, 7) = Application.WorksheetFunction.VLookup(Worksheets("Sheet1").Cells(i, 1), TargetRange, 7, False)
Next i


For i = 2 To LastRowSheet1
Worksheets("Sheet1").Cells(i, 8) = Application.WorksheetFunction.VLookup(Worksheets("Sheet1").Cells(i, 1), TargetRange, 8, False)
Next i


For i = 2 To LastRowSheet1
Worksheets("Sheet1").Cells(i, 9) = Application.WorksheetFunction.VLookup(Worksheets("Sheet1").Cells(i, 1), TargetRange, 9, False)
Next i


For i = 2 To LastRowSheet1
Worksheets("Sheet1").Cells(i, 10) = Application.WorksheetFunction.VLookup(Worksheets("Sheet1").Cells(i, 1), TargetRange, 10, False)
Next i


ErrorHandler1: Resume Next


Columns("A:J").AutoFit

End Sub
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Why wouldn't you just put all 9 lookup calculations under a single For/Next loop (instead of having 9 separate loops)?
 
Upvote 0

Forum statistics

Threads
1,223,239
Messages
6,170,947
Members
452,368
Latest member
jayp2104

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
Back
Top