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
FruitSales
Apple110
Orangie4
Pineapple21
Apple14
Apple12
Applie3
Pineapplie4
Orange5
Mango2

<tbody>
</tbody>

Working File B
FruitSales
applie10
Orange24
Pineapp21
Apple14
Apple22
Mago3
Orangie4
Mango5
Mannngo2

<tbody>
</tbody>


Working File3
FruitSales
Pineap10
Orange224
Pineapp18
Apple342
Apple456
Mangooo24
Orangie55
Mango14
Mannngo27

<tbody>
</tbody>


Desired output
all combined into one file
FruitSales
AppleXX
MangoXX
OrangeXX
PineappleXX

<tbody>
</tbody>


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

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
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
1fndListrplcList
2Apple1Apple
3Apple2Apple
4Apple3Apple
5magoMango
6OrangieOrange

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:76.04px;"><col style="width:76.04px;"></colgroup><tbody>
</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
FruitSales
Apple110
Orangie4
Pineapple21
Apple14
Apple12
Applie3
Pineapplie4
Orange5
Mango2

<tbody>
</tbody>


Working File B
FruitSales
applie10
Orange24
Pineapp21
Apple14
Apple22
Mago3
Orangie4
Mango5
Mannngo2

<tbody>
</tbody>



Working File3
FruitSales
Pineap10
Orange224
Pineapp18
Apple342
Apple456
Mangooo24
Orangie55
Mango14
Mannngo27

<tbody>
</tbody>



Output excel sheet (combined sales)

FruitSales
AppleXX
MangoXX
OrangeXX
PineappleXX

<tbody>
</tbody>




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,213,527
Messages
6,114,150
Members
448,552
Latest member
WORKINGWITHNOLEADER

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