Replace word loop

[Dani_LobP]

Hello,

I am trying to build some macro that would replace some word from a table, based on a list of words, and paste each time the table one after the other.

Example:

Cat1	10​		Replace	Cat		Horse1	10​
Cat2	20​		With	Horse		Horse2	20​
Cat3	30​			Cow		Horse3	30​
Cat4	40​			Dog		Horse4	40​
Cat5	50​			Sheep		Horse5	50​
Cat6	60​			Mouse		Horse6	60​
Cat7	70​					Horse7	70​
Cat8	80​					Horse8	80​
Cat9	90​					Horse9	90​
Cat10	100​					Horse10	100​
Cat11	110​					Horse11	110​
Cat12	120​					Horse12	120​
Cat13	130​					Horse13	130​
Cat14	140​					Horse14	140​
Cat15	150​					Horse15	150​
						Cow1	10​
						Cow2	20​
						Cow3	30​
						Cow4	40​
						Cow5	50​
						Cow6	60​
						Cow7	70​
						Cow8	80​
						Cow9	90​
						Cow10	100​
						Cow11	110​
						Cow12	120​
						Cow13	130​
						Cow14	140​
						Cow15	150​

If that makes sense already... this is what i was trying so far, i am just stuck in how to make the replacement word change to next one of the list of the with list. And how to paste at the end of the new list..

LastRow = Range("E4").End(xlDown).Row
Set Rplc = Range("E3")
Set Wth = Range("E4:E" & LastRow)

For Each cell In Wth
    Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Replace What:=Rplc, Replacement:=Wth, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A3:B32").Select
    Selection.Copy
    Range("H3").Select
    ActiveSheet.Paste
    Set Rplc = Wth
Next cell

Hope it makes sense and someone can help me with this one.

thanks in advance!

 

[Fluff]

How about

Sub DaniLobP()
   Dim Cl As Range, Rng As Range
   Dim Ary As Variant
   
   Set Rng = Range("A3", Range("B" & Rows.Count).End(xlUp))
   Ary = Rng.Value
   For Each Cl In Range("E3", Range("E" & Rows.Count).End(xlUp).Offset(-1))
      Rng.Replace Cl.Value, Cl.Offset(1).Value, xlPart, , False, , False
      Rng.Copy Range("G" & Rows.Count).End(xlUp).Offset(1)
   Next Cl
   Rng.Value = Ary
End Sub

 

[Snakehips]

@Dani_LobP Try this.

Sub Dani()
Application.ScreenUpdating = False

LastE = Range("E4").End(xlDown).Row
LastA = Range("A3").End(xlDown).Row

For R = 4 To LastE
    Set Wth = Range("E" & R)
    Set NewRng = Range("H3:I" & LastA).Offset((R - 4) * (LastA - 2), 0)
    NewRng.Formula = "=substitute(A3,$E$3," & Wth.Address & ")"
    NewRng.Value = NewRng.Value
Next R

Application.ScreenUpdating = True

End Sub

Hope that helps.
Edit: Oops... a bit late!

 

[Dani_LobP]

How about

Sub DaniLobP()
   Dim Cl As Range, Rng As Range
   Dim Ary As Variant
  
   Set Rng = Range("A3", Range("B" & Rows.Count).End(xlUp))
   Ary = Rng.Value
   For Each Cl In Range("E3", Range("E" & Rows.Count).End(xlUp).Offset(-1))
      Rng.Replace Cl.Value, Cl.Offset(1).Value, xlPart, , False, , False
      Rng.Copy Range("G" & Rows.Count).End(xlUp).Offset(1)
   Next Cl
   Rng.Value = Ary
End Sub

Thanks! i will try this, but this would be needed to be inside the loop? or it works as s loop itself? not sure if i understand the steps. but will check thanks!

 

[Dani_LobP]

thanks! i will check it also and see if also works as i expect hehe, will let know!

@Dani_LobP Try this.

Sub Dani()
Application.ScreenUpdating = False

LastE = Range("E4").End(xlDown).Row
LastA = Range("A3").End(xlDown).Row

For R = 4 To LastE
    Set Wth = Range("E" & R)
    Set NewRng = Range("H3:I" & LastA).Offset((R - 4) * (LastA - 2), 0)
    NewRng.Formula = "=substitute(A3,$E$3," & Wth.Address & ")"
    NewRng.Value = NewRng.Value
Next R

Application.ScreenUpdating = True

End Sub

Hope that helps.
Edit: Oops... a bit late!

 

[Dani_LobP]

tested it but for some reason it wont switch repalcement to the next one.. but its fine, Snakehips made similar and works as i was trying to explain so im happy :D thanks again for the help

How about

Sub DaniLobP()
   Dim Cl As Range, Rng As Range
   Dim Ary As Variant
  
   Set Rng = Range("A3", Range("B" & Rows.Count).End(xlUp))
   Ary = Rng.Value
   For Each Cl In Range("E3", Range("E" & Rows.Count).End(xlUp).Offset(-1))
      Rng.Replace Cl.Value, Cl.Offset(1).Value, xlPart, , False, , False
      Rng.Copy Range("G" & Rows.Count).End(xlUp).Offset(1)
   Next Cl
   Rng.Value = Ary
End Sub

 

[Dani_LobP]

@Dani_LobP Try this.

Sub Dani()
Application.ScreenUpdating = False

LastE = Range("E4").End(xlDown).Row
LastA = Range("A3").End(xlDown).Row

For R = 4 To LastE
    Set Wth = Range("E" & R)
    Set NewRng = Range("H3:I" & LastA).Offset((R - 4) * (LastA - 2), 0)
    NewRng.Formula = "=substitute(A3,$E$3," & Wth.Address & ")"
    NewRng.Value = NewRng.Value
Next R

Application.ScreenUpdating = True

End Sub

Hope that helps.
Edit: Oops... a bit late!

Works wonders! thanks a lot mate, appreciated, never too late :D hehe