lookup and replace

jmkerzic

New Member
Joined
Jul 5, 2019
Messages
31
I have the following. I am trying to find the value column M in column k and if I it is in column K have it replace the Column L with the value that is in Column N. this is just a sample of the spreadsheet that I am using.

K L M N
492014201335001192288171135
124​
492007999706001192288172101
124​
492011222050001192288170909
124​
492016086169001192288171180
521​
492007483984001192288171012
124​
492018157829001192288170930
127​
492011523423001192288170862
003​
492007676058001192288171197
124​
492011632576001192288171265
124​
492014647669001192288171227
124​
492007528739001192288171128
124​
492011223262001192288171166
124​
492014290599001192288171142
124​
492014200338001192288171173
124​
492014200277001192288170947
124​
492014200321001192288170954
124​
492014864080001192288170893
124​
492011523645001192288170879
124​
492014683452001192288171272
124​
492011359763001192288170961
124​
 

Attachments

  • 1575647995781.png
    1575647995781.png
    3 KB · Views: 5

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Hi, try this.
I replace some values, for testing purpose

ABCDEFGHIJKLMNOP
492014201335001192288171135124
492007999706001192288172101124
492011222050001492011222050124001
492016086169020492011523423521020
492007483984001192288171012124
492018157829001192288170930127
492011523423001192288170862003
492007676058001192288171197124
492011632576001192288171265124
492014647669003492011223262124003
492007528739001192288171128124
492011223262001192288171166124
492014290599001192288171142124
492014200338001192288171173124
492014200277001192288170947124
492014200321001192288170954124
492014864080001192288170893124
492011523645001192288170879124
492014683452001192288171272124
492011359763001192288170961124

Book1
ABCDEFGHIJKLMNOP
14.92014E+1111.92288E+11124
24.92008E+1111.92288E+11124
34.92011E+1114.92011E+111241
44.92016E+11204.92012E+1152120
54.92007E+1111.92288E+11124
64.92018E+1111.92288E+11127
74.92012E+1111.92288E+11003
84.92008E+1111.92288E+11124
94.92012E+1111.92288E+11124
104.92015E+1134.92011E+111243
114.92008E+1111.92288E+11124
124.92011E+1111.92288E+11124
134.92014E+1111.92288E+11124
144.92014E+1111.92288E+11124
154.92014E+1111.92288E+11124
164.92014E+1111.92288E+11124
174.92015E+1111.92288E+11124
184.92012E+1111.92288E+11124
194.92015E+1111.92288E+11124
204.92011E+1111.92288E+11124
Sheet1


VBA Code:
Option Explicit

'Hernan Torres, Mikel ERP
'December 6, 2019
'Buscar y reemplazar coincidentes
'Check and replace

Sub check_and_replace()
Dim rng As Range
Dim cell As Range
Dim myFindRange As Range
Dim myCompareRange As Range
Dim variante As Integer


Application.ScreenUpdating = False
On Error GoTo ctrl_error

Set myFindRange = Range("K1", ActiveSheet.Cells(Rows.Count, "K").End(xlUp).Offset(1, 0))
Set myCompareRange = Range("M1", ActiveSheet.Cells(Rows.Count, "M").End(xlUp).Offset(1, 0))


For Each cell In myCompareRange
Debug.Print cell.Value & " " & cell.Row
variante = Application.WorksheetFunction.IfError(Application.WorksheetFunction.Match(cell.Value, myFindRange, 0), 0)
If variante <> 0 Then
'first save last value
'Debug.Print Cells(cell.Row, cell.Column).Offset(0, 3).Address
'Debug.Print Cells(cell.Row, cell.Column).Offset(0, -1).Value
Cells(cell.Row, cell.Column).Offset(0, 3) = Cells(cell.Row, cell.Column).Offset(0, -1) 'for testing purpose, you can delete

'Debug.Print Cells(cell.Row, cell.Column).Offset(0, -1).Address
'Debug.Print Cells(cell.Row, cell.Column).Offset(0, 1).Value
Cells(cell.Row, cell.Column).Offset(0, -1) = Cells(cell.Row, cell.Column).Offset(0, 1)
End If
Next cell

salir:
GoTo finalizar

ctrl_error:
variante = 0
'Debug.Print Err.Number & " " & Err.Description
Select Case Err.Number
Case 0
Resume salir
Case 1004
Resume Next
End Select

finalizar:
Range("J1").Activate
'Run ("pivotRefresh") 'if you have one
MsgBox "Variants were created!!!", vbInformation, "Mikel ERP by htorres"
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Assuming that in row 1 you have headings and your data starts in row 2, try this.

VBA Code:
Sub Lookup_and_Replace()
  Dim a(), b(), i As Long, n As Variant
  a = Range("K2", Range("L" & Rows.Count).End(xlUp)).Value
  b = Range("M2", Range("N" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(b, 1)
    n = Application.Match(b(i, 1), Application.Index(a, , 1), 0)
    If Not IsError(n) Then a(n, 2) = b(i, 2)
  Next
  Range("L2").Resize(UBound(a)).Value = Application.Index(a, , 2)
End Sub
 
Upvote 0
Just another way

VBA Code:
Sub Lookup_and_Replace_2()
  Dim a(), b(), i As Long, dic As Object
  a = Range("K2", Range("L" & Rows.Count).End(xlUp)).Value
  b = Range("M2", Range("N" & Rows.Count).End(xlUp)).Value
  Set dic = CreateObject("scripting.dictionary")
  For i = 1 To UBound(b, 1)
    dic(b(i, 1)) = b(i, 2)
  Next
  For i = 1 To UBound(a, 1)
    If dic.exists(a(i, 1)) Then a(i, 2) = dic(a(i, 1))
  Next
  Range("L2").Resize(UBound(a)).Value = Application.Index(a, , 2)
End Sub
 
Upvote 0
Awesome. works perfect.

Assuming that in row 1 you have headings and your data starts in row 2, try this.

VBA Code:
Sub Lookup_and_Replace()
  Dim a(), b(), i As Long, n As Variant
  a = Range("K2", Range("L" & Rows.Count).End(xlUp)).Value
  b = Range("M2", Range("N" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(b, 1)
    n = Application.Match(b(i, 1), Application.Index(a, , 1), 0)
    If Not IsError(n) Then a(n, 2) = b(i, 2)
  Next
  Range("L2").Resize(UBound(a)).Value = Application.Index(a, , 2)
End Sub
Assuming that in row 1 you have headings and your data starts in row 2, try this.
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0
Clean and combined code, apliying Dante suggestion

VBA Code:
Option Explicit
Sub check_and_replace()
Dim cell As Range
Dim myFindRange As Range
Dim myCompareRange As Range
Dim variante As Variant

Application.ScreenUpdating = False
On Error GoTo ctrl_error

Set myFindRange = Range("K2", ActiveSheet.Cells(Rows.Count, "K").End(xlUp).Offset(1, 0))
Set myCompareRange = Range("M2", ActiveSheet.Cells(Rows.Count, "M").End(xlUp).Offset(1, 0))
For Each cell In myCompareRange
variante = Application.Match(cell.Value, myFindRange, 0)
If Not IsError(variante) Then
Cells(cell.Row, cell.Column).Offset(0, 3) = Cells(cell.Row, cell.Column).Offset(0, -1) 'for testing purpose, you can delete
Cells(cell.Row, cell.Column).Offset(0, -1) = Cells(cell.Row, cell.Column).Offset(0, 1)
End If
Next cell

salir:
GoTo finalizar

ctrl_error:
Select Case Err.Number
Case 0
Set myFindRange = Nothing
Set myCompareRange = Nothing
Resume salir
Case Else
MsgBox "Error N: " & Err.Number & " - " & Err.Description
End Select

finalizar:
Range("J1").Activate
MsgBox "Variants were created!!!", vbInformation, "Mikel ERP by htorres"
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,215,046
Messages
6,122,849
Members
449,096
Latest member
Erald

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