Populate VLOOKUP formula using VBA for all rows that have data in column A

bradgivens

New member
Joined
Dec 9, 2018
Messages
4
Reaction score
0
Points
0
Excel Version(s)
2016
Hello,

I have a data set that includes scores for individuals, but the report lacks team manager assignments. I have a separate table that contains team manager assignments. The tricky part is that people change managers, and I have to keep the scores tied to the manager, and only new data would then be transferred to the new manager.

My thinking is that I have a query tab that I paste the data into. There is a column that always says "Item" for each record and isn't used for my purposes. So I thought if I made a control button that runs a VLOOKUP to pull the team manager assignment, within an If statement, for If the record contains "Item" in the specified column, then VLOOKUP runs and replaces the work "Item" with the Manager's Name. That way it would preserve the scores tied to the specific manager if someone changes managers.

THE PROBLEM: It seems that the macro runs for the first row correctly, however, it just repeats the same manager's name throughout the entire table where it says "Item". How can I make it pull the VLOOKUP data for each row and populate the correct team manager.

CODE:
Sub AssignTeams()



If Sheets("CallScrubQuery").Range("G2") = "Item" Then
Range("G2:G" & Range("A" & Rows.Count).End(xlUp).Row).Formula = Application.WorksheetFunction.VLookup(Sheets("CallScrubQuery").Range("A2"), Sheets("TeamAssignment").Range("$A$2:$B$200"), 2, False)
End If



End Sub
 
Hi & welcome to the board.
How about
Code:
Sub bradgivens()
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   Dim Cl As Range
   
   Set Ws1 = Sheets("TeamAssignment")
   Set Ws2 = Sheets("CallScrubQuery")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 1).Value
      Next Cl
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         If Cl.Offset(, 6).Value = "item" Then Cl.Offset(, 6).Value = .Item(Cl.Value)
      Next Cl
   End With
End Sub
 
Thanks for your reply

Hello,

First I must apologize, I am very much a beginner. When I enter the code exactly as entered below, nothing happens. If I enter my code inside of the code, the same thing happens, where it just lists the VLOOKUP's return of the first row on all following rows. I have attached my workbook so hopefully that will help. I tried the code below:

Sub AssignTeams()
Dim Ws1 As Worksheet, Ws2 As Worksheet
View attachment Sbrubbing Analysis - Copy.xlsx Dim Cl As Range


Set Ws1 = Sheets("TeamAssignment")
Set Ws2 = Sheets("CallScrubQuery")
With CreateObject("scripting.dictionary")
For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
.Item(Cl.Value) = Cl.Offset(, 1).Value
If Sheets("CallScrubQuery").Range("G2") = "Item" Then
Range("G2:G" & Range("A" & Rows.Count).End(xlUp).Row).Formula = Application.WorksheetFunction.VLookup(Sheets("CallScrubQuery").Range("A2"), Sheets("TeamAssignment").Range("$A$2:$B$200"), 2, False)
End If
Next Cl
For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
If Cl.Offset(, 6).Value = "item" Then Cl.Offset(, 6).Value = .Item(Cl.Value)
Next Cl
End With
End Sub
 
Make this change
Code:
If Cl.Offset(, 6).Value = "[COLOR=#ff0000]I[/COLOR]tem" Then Cl.Offset(, 6).Value = .Item(Cl.Value)
 
Thanks for your reply

I made the suggested correction, however, when I run the code in the sample workbook that I will attach here, they all end up saying "Duke".
 

Attachments

  • Sbrubbing Analysis - Copy.xlsm
    39.8 KB · Views: 16
Thanks for your reply

Please also see my previous reply.

I played around with this a little more and I got the function to work properly. However, I noticed that my If statement always checks G2, instead of checking the current row for the G column. How can I indicate that I want the if statement to always look for the value in the G column for the row that I am inserting the VLOOKUP function?

Sub AssignTeamsCalls()



If Sheets("CallScrubQuery").Range("G2") = "Item" Then
Range("G2:G" & Range("A" & Rows.Count).End(xlUp).Row).Formula = "=VLookup([@CSM], Teams, 2, False)"
End If





End Sub
 
Hi and welcome
please wrap your code with code tags ( select the code and click the #button). it keeps the code structure ( see post #2 as an example) and makes the thread easier to read. Thx
 
The code I supplied along with the change I mentioned works for me on your test file.
 

Attachments

  • Sbrubbing Analysis - Copy.xlsm
    35.4 KB · Views: 25
Back
Top