VBA to look down column and over write cell with text from list

[pete4monc]

Hi all

I hope you could help a beginner.

I need the vba to look down column B on sheet1.
Find the material in the first cell that matches the material in the list on sheet2 and change (over write) the material in that first cell for the corresponding name in column B of sheet 2.
Sheet1 will change daily via copy and pasting the full sheet so I can not use vlookups.

Hope this all makes sense?

I have some code which works but it is very long winded and seems to take forever to run the longer the code gets.
I was wondering if the vba could lookup from a list on sheet two?

 

[AlphaFrog]

Sub Change_All()
    Dim cell As Range
    Dim Found As Range
    With Sheets("Sheet2")
        For Each cell In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            Set Found = Sheets("Sheet1").Range("B:B").Find(cell.Value, Sheets("Sheet1").Range("B1"), xlValues, xlWhole, 1, 1, 0)
            If Not Found Is Nothing Then Found.Value = cell.Offset(0, 1).Value
        Next cell
    End With
    MsgBox "Changes complete.", vbInformation, "Change All"
End Sub

 

[pete4monc]

Sub Change_All()
    Dim cell As Range
    Dim Found As Range
    With Sheets("Sheet2")
        For Each cell In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            Set Found = Sheets("Sheet1").Range("B:B").Find(cell.Value, Sheets("Sheet1").Range("B1"), xlValues, xlWhole, 1, 1, 0)
            If Not Found Is Nothing Then Found.Value = cell.Offset(0, 1).Value
        Next cell
    End With
    MsgBox "Changes complete.", vbInformation, "Change All"
End Sub

Hi AlphaFrog.

Thanks for your help.
All seems to work but it will only change the first instance of the text and does not run down the whole B column on Sheet1.

 

[Peter_SSs]

Try this with a copy of your data

Sub Replace_Values()
  Dim c As Range
  
  Application.ScreenUpdating = False
  For Each c In Sheets("Sheet2").Range("A1", Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp))
    Sheets("Sheet1").Columns("B").Replace What:="*" & c.Value & "*", Replacement:=c.Offset(, 1).Value
  Next c
  Application.ScreenUpdating = True
End Sub

 

[pete4monc]

Try this with a copy of your data

Sub Replace_Values()
  Dim c As Range
 
  Application.ScreenUpdating = False
  For Each c In Sheets("Sheet2").Range("A1", Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp))
    Sheets("Sheet1").Columns("B").Replace What:="*" & c.Value & "*", Replacement:=c.Offset(, 1).Value
  Next c
  Application.ScreenUpdating = True
End Sub

Thank you Peter_SSs.

This works fantastic.

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.