Find and replace macro for multiple worksheets/items - newbie

CCK0857

New Member
Joined
Jul 3, 2019
Messages
5
Hi all,

This has been quite a wonderful forum and great place to learn.

I have the below problem which I require some advice.

1. I am trying to consolidate the sales of a few items from 3 different sources (3 different worksheets)
2. These 3 different worksheets name all these items differently.
3. What I did was I wrote a simple macro to find and replace all these different variations into one consistent naming
4. The issue is I used arrays in my macro and there are way too many items to cater for
5. Like to ask if there is an easier way to do it if I continue with the find and replace method?
6. Or if there is even an easier solution to tackle this (without using find and replace)?

Below are my working files and VBA text. Thank you sirs in advance

Working files

Working file A
[TABLE="width: 144"]
<tbody>[TR]
[TD]Fruit[/TD]
[TD]Sales[/TD]
[/TR]
[TR]
[TD]Apple1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]Orangie[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Pineapple[/TD]
[TD="align: right"]21[/TD]
[/TR]
[TR]
[TD]Apple1[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Apple1[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]Applie[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]Pineapplie[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Orange[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD]Mango[/TD]
[TD="align: right"]2[/TD]
[/TR]
</tbody>[/TABLE]

Working File B
[TABLE="width: 128"]
<tbody>[TR]
[TD]Fruit[/TD]
[TD]Sales[/TD]
[/TR]
[TR]
[TD]applie[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]Orange2[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Pineapp[/TD]
[TD="align: right"]21[/TD]
[/TR]
[TR]
[TD]Apple1[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Apple2[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]Mago[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]Orangie[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Mango[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD]Mannngo[/TD]
[TD="align: right"]2[/TD]
[/TR]
</tbody>[/TABLE]


Working File3
[TABLE="width: 164"]
<tbody>[TR]
[TD]Fruit[/TD]
[TD]Sales[/TD]
[/TR]
[TR]
[TD]Pineap[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]Orange2[/TD]
[TD="align: right"]24[/TD]
[/TR]
[TR]
[TD]Pineapp[/TD]
[TD="align: right"]18[/TD]
[/TR]
[TR]
[TD]Apple3[/TD]
[TD="align: right"]42[/TD]
[/TR]
[TR]
[TD]Apple4[/TD]
[TD="align: right"]56[/TD]
[/TR]
[TR]
[TD]Mangooo[/TD]
[TD="align: right"]24[/TD]
[/TR]
[TR]
[TD]Orangie[/TD]
[TD="align: right"]55[/TD]
[/TR]
[TR]
[TD]Mango[/TD]
[TD="align: right"]14[/TD]
[/TR]
[TR]
[TD]Mannngo[/TD]
[TD="align: right"]27[/TD]
[/TR]
</tbody>[/TABLE]


Desired output
all combined into one file
[TABLE="width: 162"]
<tbody>[TR]
[TD]Fruit[/TD]
[TD]Sales[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]XX[/TD]
[/TR]
[TR]
[TD]Mango[/TD]
[TD]XX[/TD]
[/TR]
[TR]
[TD]Orange[/TD]
[TD]XX[/TD]
[/TR]
[TR]
[TD]Pineapple[/TD]
[TD]XX[/TD]
[/TR]
</tbody>[/TABLE]


Macro text
Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook


Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array("Apple1", "apple2", "mago", "Orangie")
rplcList = Array("Apple", "Apple", "Mango", "Orange")

'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht

Next x

End Sub
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Put the relationship on a sheet called "Custom" as shown in the following example:

<table style="font-family:Arial; font-size:12pt; border-style: groove ;border-color:#0000FF;background-color:#fffcf9; color:#000000; "><tr><td ><b>Custom</b></td></tr></table>
<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:76.04px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td style="background-color:#ffff00; font-weight:bold; text-align:center; ">fndList</td><td style="background-color:#ffff00; font-weight:bold; text-align:center; ">rplcList</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >Apple1</td><td >Apple</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td >Apple2</td><td >Apple</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td >Apple3</td><td >Apple</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td >mago</td><td >Mango</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td >Orangie</td><td >Orange</td></tr></table>

Try this:

Code:
Sub Multi_FindReplace()
    'PURPOSE: Find & Replace a list of text/values throughout entire workbook
    Dim sht As Worksheet, sh As Worksheet, c As Range
    Set sh = Worksheets("Custom")
    For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(xlUp))  'Loop each item in column "A"
        For Each sht In ActiveWorkbook.Worksheets                       'Loop each sheet in Workbook
            If sht.Name <> sh.Name Then
                sht.Cells.Replace c.Value, c.Offset(, 1).Value, xlPart
            End If
        Next
    Next
    MsgBox "Done"
End Sub
 
Upvote 0
Awesome. Thanks Dante.

However, Can I check with you on how do I make the desired values combine and appear on a new worksheet with the correct output?

Or should I combine them first, then find and replace? Thanks

Regards


Put the relationship on a sheet called "Custom" as shown in the following example:

Custom

<tbody>
</tbody>

AB
Apple1Apple
Apple2Apple
Apple3Apple
magoMango
OrangieOrange

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:76.04px;"><col style="width:76.04px;"></colgroup><tbody>
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]1[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=ffff00]#ffff00[/URL] , align: center"]fndList[/TD]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=ffff00]#ffff00[/URL] , align: center"]rplcList[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]2[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]3[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]4[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]5[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]6[/TD]

</tbody>


Try this:

Code:
Sub Multi_FindReplace()
    'PURPOSE: Find & Replace a list of text/values throughout entire workbook
    Dim sht As Worksheet, sh As Worksheet, c As Range
    Set sh = Worksheets("Custom")
    For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(xlUp))  'Loop each item in column "A"
        For Each sht In ActiveWorkbook.Worksheets                       'Loop each sheet in Workbook
            If sht.Name <> sh.Name Then
                sht.Cells.Replace c.Value, c.Offset(, 1).Value, xlPart
            End If
        Next
    Next
    MsgBox "Done"
End Sub
 
Upvote 0
Awesome. Thanks Dante.

However, Can I check with you on how do I make the desired values combine and appear on a new worksheet with the correct output?

Or should I combine them first, then find and replace? Thanks

Regards

You can explain it with examples.
 
Upvote 0
Thanks Dante and apologies for not providing sufficient info earlier.

So lets say I have three working files. I now know how to replace the wrong naming with the correct naming thanks to your guidance.

So if I want to go one step further. After replacing the wrong naming with the correct names, I want to auto sum the sales and put them into one new excel sheet. How do i do so? Examples below

Many thanks once again


Working file A
[TABLE="class: cms_table, width: 144"]
<tbody>[TR]
[TD]Fruit[/TD]
[TD]Sales[/TD]
[/TR]
[TR]
[TD]Apple1[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]Orangie[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Pineapple[/TD]
[TD="align: right"]21[/TD]
[/TR]
[TR]
[TD]Apple1[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Apple1[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]Applie[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]Pineapplie[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Orange[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD]Mango[/TD]
[TD="align: right"]2[/TD]
[/TR]
</tbody>[/TABLE]


Working File B
[TABLE="class: cms_table, width: 128"]
<tbody>[TR]
[TD]Fruit[/TD]
[TD]Sales[/TD]
[/TR]
[TR]
[TD]applie[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]Orange2[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Pineapp[/TD]
[TD="align: right"]21[/TD]
[/TR]
[TR]
[TD]Apple1[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Apple2[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD]Mago[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD]Orangie[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]Mango[/TD]
[TD="align: right"]5[/TD]
[/TR]
[TR]
[TD]Mannngo[/TD]
[TD="align: right"]2[/TD]
[/TR]
</tbody>[/TABLE]



Working File3
[TABLE="class: cms_table, width: 164"]
<tbody>[TR]
[TD]Fruit[/TD]
[TD]Sales[/TD]
[/TR]
[TR]
[TD]Pineap[/TD]
[TD="align: right"]10[/TD]
[/TR]
[TR]
[TD]Orange2[/TD]
[TD="align: right"]24[/TD]
[/TR]
[TR]
[TD]Pineapp[/TD]
[TD="align: right"]18[/TD]
[/TR]
[TR]
[TD]Apple3[/TD]
[TD="align: right"]42[/TD]
[/TR]
[TR]
[TD]Apple4[/TD]
[TD="align: right"]56[/TD]
[/TR]
[TR]
[TD]Mangooo[/TD]
[TD="align: right"]24[/TD]
[/TR]
[TR]
[TD]Orangie[/TD]
[TD="align: right"]55[/TD]
[/TR]
[TR]
[TD]Mango[/TD]
[TD="align: right"]14[/TD]
[/TR]
[TR]
[TD]Mannngo[/TD]
[TD="align: right"]27[/TD]
[/TR]
</tbody>[/TABLE]



Output excel sheet (combined sales)

[TABLE="class: cms_table, width: 162"]
<tbody>[TR]
[TD]Fruit[/TD]
[TD]Sales[/TD]
[/TR]
[TR]
[TD]Apple[/TD]
[TD]XX[/TD]
[/TR]
[TR]
[TD]Mango[/TD]
[TD]XX[/TD]
[/TR]
[TR]
[TD]Orange[/TD]
[TD]XX[/TD]
[/TR]
[TR]
[TD]Pineapple[/TD]
[TD]XX[/TD]
[/TR]
</tbody>[/TABLE]




Regards


You can explain it with examples.
 
Upvote 0
Still missing information.
Column of fruits, column of sales.
Assuming that they are columns A and B and data begin in row 2

Try this

Code:
Sub one_step_further()
    Dim sh As Worksheet, sh1 As Worksheet, c As Range, f As Range
    Set sh1 = Sheets("combined")
    sh1.Rows("2:" & Rows.Count).ClearContents
    For Each sh In Sheets
        Select Case sh.Name
            Case "Custom", sh1.Name
            Case Else
                For Each c In sh.Range("A2", sh.Range("A" & Rows.Count).End(xlUp))
                    Set f = sh1.Range("A:A").Find(c, LookIn:=xlValues, lookat:=xlWhole)
                    If Not f Is Nothing Then
                        f.Offset(, 1) = f.Offset(, 1) + c.Offset(, 1)
                    Else
                        sh1.Range("A" & Rows.Count).End(xlUp)(2).Value = c.Value
                        sh1.Range("B" & Rows.Count).End(xlUp)(2).Value = c.Offset(, 1)
                    End If
                Next
        End Select
    Next
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

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