Macro to replace values in a range (similar to vlookup or index/match)

ChristineJ

Well-known Member
Joined
May 18, 2009
Messages
771
Office Version
  1. 365
Platform
  1. Windows
Can a macro REPLACE all the numerical values in columns D through L (there will be at least 5,000 rows) with a value from column C?

The value in each cell in columns D through L matches one of the unique values in A2:A155. The value in column C on that same row as the match in column A should replace each original value.

Example 1: The value in E2 below is 3. That matches with the value in cell A4. The value in C4 is "Yellow". The word "Yellow" should replace the "3" in cell E2.

Example 2: The value in G4 below is 14. That matches with the value in cell A15. The value in C15 is "Fred". The word "Fred" should replace the "14" in cell G4.

[TABLE="width: 996"]
<colgroup><col><col><col span="11"></colgroup><tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[TD]H[/TD]
[TD]I[/TD]
[TD]J[/TD]
[TD]K[/TD]
[TD]L[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]ID[/TD]
[TD]Item[/TD]
[TD]Value[/TD]
[TD]Date[/TD]
[TD]Product[/TD]
[TD]Region[/TD]
[TD]Salesperson[/TD]
[TD]Customer[/TD]
[TD]Price[/TD]
[TD]Discount[/TD]
[TD]Warranty[/TD]
[TD]Distribution[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]1[/TD]
[TD]Product 1[/TD]
[TD]Red[/TD]
[TD]140[/TD]
[TD]3[/TD]
[TD]7[/TD]
[TD]17[/TD]
[TD]35[/TD]
[TD]49[/TD]
[TD]60[/TD]
[TD]64[/TD]
[TD]66[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]2[/TD]
[TD]Product 2[/TD]
[TD]Green[/TD]
[TD]135[/TD]
[TD]4[/TD]
[TD]6[/TD]
[TD]15[/TD]
[TD]30[/TD]
[TD]54[/TD]
[TD]57[/TD]
[TD]62[/TD]
[TD]66[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]3[/TD]
[TD]Product 3[/TD]
[TD]Yellow[/TD]
[TD]123[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]14[/TD]
[TD]30[/TD]
[TD]52[/TD]
[TD]57[/TD]
[TD]61[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]4[/TD]
[TD]Product 4[/TD]
[TD]Blue[/TD]
[TD]115[/TD]
[TD]4[/TD]
[TD]7[/TD]
[TD]20[/TD]
[TD]33[/TD]
[TD]55[/TD]
[TD]57[/TD]
[TD]63[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]5[/TD]
[TD]Region 1[/TD]
[TD]North[/TD]
[TD]84[/TD]
[TD]4[/TD]
[TD]6[/TD]
[TD]13[/TD]
[TD]30[/TD]
[TD]53[/TD]
[TD]60[/TD]
[TD]64[/TD]
[TD]66[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]6[/TD]
[TD]Region 2[/TD]
[TD]South[/TD]
[TD]135[/TD]
[TD]2[/TD]
[TD]8[/TD]
[TD]22[/TD]
[TD]37[/TD]
[TD]48[/TD]
[TD]58[/TD]
[TD]61[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]7[/TD]
[TD]Region 3[/TD]
[TD]East[/TD]
[TD]151[/TD]
[TD]2[/TD]
[TD]6[/TD]
[TD]14[/TD]
[TD]31[/TD]
[TD]48[/TD]
[TD]58[/TD]
[TD]61[/TD]
[TD]66[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]8[/TD]
[TD]Region 4[/TD]
[TD]West[/TD]
[TD]128[/TD]
[TD]1[/TD]
[TD]8[/TD]
[TD]23[/TD]
[TD]40[/TD]
[TD]44[/TD]
[TD]60[/TD]
[TD]63[/TD]
[TD]66[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]9[/TD]
[TD]Person 1[/TD]
[TD]Adam[/TD]
[TD]126[/TD]
[TD]3[/TD]
[TD]7[/TD]
[TD]18[/TD]
[TD]35[/TD]
[TD]50[/TD]
[TD]60[/TD]
[TD]64[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]10[/TD]
[TD]Person 2[/TD]
[TD]Bill[/TD]
[TD]94[/TD]
[TD]4[/TD]
[TD]6[/TD]
[TD]15[/TD]
[TD]32[/TD]
[TD]54[/TD]
[TD]58[/TD]
[TD]64[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD]11[/TD]
[TD]Person 3[/TD]
[TD]Carl[/TD]
[TD]131[/TD]
[TD]3[/TD]
[TD]7[/TD]
[TD]19[/TD]
[TD]34[/TD]
[TD]51[/TD]
[TD]57[/TD]
[TD]63[/TD]
[TD]66[/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD]12[/TD]
[TD]Person 4[/TD]
[TD]Dave[/TD]
[TD]70[/TD]
[TD]2[/TD]
[TD]8[/TD]
[TD]23[/TD]
[TD]39[/TD]
[TD]47[/TD]
[TD]58[/TD]
[TD]63[/TD]
[TD]66[/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD]13[/TD]
[TD]Person 5[/TD]
[TD]Evan[/TD]
[TD]82[/TD]
[TD]2[/TD]
[TD]6[/TD]
[TD]16[/TD]
[TD]31[/TD]
[TD]48[/TD]
[TD]57[/TD]
[TD]64[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]15[/TD]
[TD]14[/TD]
[TD]Person 6[/TD]
[TD]Fred[/TD]
[TD]113[/TD]
[TD]1[/TD]
[TD]6[/TD]
[TD]16[/TD]
[TD]32[/TD]
[TD]42[/TD]
[TD]60[/TD]
[TD]61[/TD]
[TD]66[/TD]
[/TR]
[TR]
[TD]16[/TD]
[TD]15[/TD]
[TD]Person 7[/TD]
[TD]Gary[/TD]
[TD]77[/TD]
[TD]2[/TD]
[TD]6[/TD]
[TD]14[/TD]
[TD]29[/TD]
[TD]48[/TD]
[TD]58[/TD]
[TD]63[/TD]
[TD]66[/TD]
[/TR]
[TR]
[TD]17[/TD]
[TD]16[/TD]
[TD]Person 8[/TD]
[TD]Hank[/TD]
[TD]81[/TD]
[TD]1[/TD]
[TD]7[/TD]
[TD]18[/TD]
[TD]36[/TD]
[TD]42[/TD]
[TD]57[/TD]
[TD]63[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]18[/TD]
[TD]17[/TD]
[TD]Person 9[/TD]
[TD]Ivan[/TD]
[TD]153[/TD]
[TD]1[/TD]
[TD]5[/TD]
[TD]10[/TD]
[TD]25[/TD]
[TD]44[/TD]
[TD]58[/TD]
[TD]62[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]19[/TD]
[TD]18[/TD]
[TD]Person 10[/TD]
[TD]John[/TD]
[TD]111[/TD]
[TD]3[/TD]
[TD]6[/TD]
[TD]16[/TD]
[TD]31[/TD]
[TD]52[/TD]
[TD]57[/TD]
[TD]64[/TD]
[TD]66[/TD]
[/TR]
[TR]
[TD]20[/TD]
[TD]19[/TD]
[TD]Person 11[/TD]
[TD]Kent[/TD]
[TD]100[/TD]
[TD]2[/TD]
[TD]8[/TD]
[TD]21[/TD]
[TD]38[/TD]
[TD]47[/TD]
[TD]59[/TD]
[TD]62[/TD]
[TD]65[/TD]
[/TR]
[TR]
[TD]21[/TD]
[TD]20[/TD]
[TD]Person 12[/TD]
[TD]Liam[/TD]
[TD]82[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]11[/TD]
[TD]25[/TD]
[TD]56[/TD]
[TD]57[/TD]
[TD]62[/TD]
[TD]65[/TD]
[/TR]
</tbody>[/TABLE]

Thanks for any help on this!
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
See how next code can help


Code:
Option Explicit


Sub ChangeData()
'
Dim DataDic   As Object
Set DataDic = CreateObject("Scripting.Dictionary")
Dim Rg  As Range
Dim Wkrg As Range


    For Each Rg In Range([A2], Cells(Rows.Count, 1).End(3))
        DataDic.Item(Rg.Value) = Rg(1, 3).Value
    Next Rg
    Set Wkrg = ActiveSheet.UsedRange
    Set Wkrg = Intersect(Wkrg, Wkrg.Offset(1, 3))
    For Each Rg In Wkrg
        With DataDic
            If (.exists(Rg.Value)) Then Rg = .Item(Rg.Value)
        End With
    Next Rg
End Sub
 
Last edited:
Upvote 0
It works wonderfully!

The only minor thing is that the last column I use is L, but it also fills in the word "Value" for all of the rows in column M. I can easily add code to delete column M after your code runs if there not a quick adjustment.

Thanks so much! This is not something I could even come close to doing myself. CJ
 
Upvote 0
Here we are,
Code:
Option Explicit


Sub ChangeData()
'
Dim DataDic   As Object
Set DataDic = CreateObject("Scripting.Dictionary")
Dim Rg  As Range
Dim Wkrg As Range
Const ColLst = "D:L"
    For Each Rg In Range([A2], Cells(Rows.Count, 1).End(3))
        DataDic.Item(Rg.Value) = Rg(1, 3).Value
    Next Rg
    Set Wkrg = ActiveSheet.UsedRange
    Set Wkrg = Intersect(Wkrg, Columns(ColLst))
    Set Wkrg = Intersect(Wkrg, Wkrg.Offset(1, 0))
    Application.ScreenUpdating = False
    For Each Rg In Wkrg
        With DataDic
            If (.exists(Rg.Value)) Then Rg = .Item(Rg.Value)
        End With
    Next Rg
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
If all your columns have about 5000 rows, then this variation should be a bit quicker.
Code:
Sub MakeReplacements()
  Dim d As Object
  Dim a As Variant
  Dim i As Long, j As Long, ub2 As Long
  
  Set d = CreateObject("Scripting.dictionary")
  a = Range("A2:L" & Range("A" & Rows.Count).End(xlUp).Row).Value
  ub2 = UBound(a, 2)
  For i = 1 To UBound(a)
    d(a(i, 1)) = a(i, 3)
  Next i
  For i = 1 To UBound(a)
    For j = 4 To ub2
      If d.exists(a(i, j)) Then a(i, j) = d(a(i, j))
    Next j
  Next i
  Range("A2").Resize(UBound(a), ub2).Value = a
End Sub
 
Upvote 0
Good news, it was a great pleasure!
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

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