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
 

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,171
Office Version
2007
Platform
Windows
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
 

CCK0857

New Member
Joined
Jul 3, 2019
Messages
5
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,171
Office Version
2007
Platform
Windows
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.
 

CCK0857

New Member
Joined
Jul 3, 2019
Messages
5
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.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,171
Office Version
2007
Platform
Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,102,302
Messages
5,486,053
Members
407,529
Latest member
netojose

This Week's Hot Topics

Top