• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Find and replace with vba

A

Arpanakumar

Member
Hello

I need help in finding multiple words and replacing them with other..

Actually i have multiple sheets in my excel workbook..

and also require msgbox to show how many replaced if not replaced should show as no action taken...

As file is very big to attach sorry for that.

Thanks.
 
Dear.

Try this..

Below code will help you to find and replace and it will search in each sheet and replace...Let me know any challenges.

Try replacing Array with the words you wanted to find and replace...

Code: 
Sub Multi_FindReplace()
Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long

fndList = Array("AA", "BB")
rplcList = Array("A", "B")

  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
 
Thanks Monty.

That was so quick..Thanks to chandoo to have experts...

I will test this code but i can see this will find two words and two replacements only i believe..Any suggestions.
 
That's great.

Iam on testing code now will get back to you...Please help me in completing my project that would be great.

May be will have many questions..
 
Fantastic Monty.

It works very well..

need some changes in the code.

1) I do not want the user to change the finding and replacing words in code need to think dynamic.

2) Need how much time took to complete the process may be msgbox at the end as i said my file is real big..So wanted to check the time.

3) Need how many words found and replaced with msgbox for Example..
How many AA replace with A and BB replace with B, and CC not found.

4) When macro found nothing and not replaced anything then show message...No action taken.


Hope this make sense.
 
Arpana.

Let me take step by step.

As per your Question 1: No need your user to go and change words in the code..user can change his requirements in the sheet 1.

Tested and working fine...Let me know for you any challenges.
 

Attachments

  • Arpana.xlsb
    21.9 KB · Views: 3
Arpana.


Here is the solution for your second queston...Make sure you use

StartTime = Timer****Beginning of your code

MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

MsgBox "Time Taken to run " & MinutesElapsed & " minutes", vbInformation******End of your code before End Sub..ofcourse.



Code: 
Sub Test()
Dim StartTime As Double
Dim MinutesElapsed As String

  StartTime = Timer

<<<<'Insert Your Code Here...>>>


MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

  MsgBox "Time Taken to run " & MinutesElapsed & " minutes", vbInformation

End Sub
 
Monty many thanks..

Iam checking now and please be online as i have to complete my project and have few more questions...Hopefully you are going to give me solutions for the rest of the questions...looking forward for your answer...Thanks.
 
Sorry for further delay..
Could not find solution still working on your third point..Let's see if some one respond to it...
Code: 
3) Need how many words found and replaced with msgbox for Example..
How many AA replace with A and BB replace with B, and CC not found.
 
Dear Arpana.

I just put your question again in the forum.. So that we can get some quick help..Sorry could not do much on third & fourth points..Still let me try from my end.
 
Check this...

Code: 
Sub Find_Replace()

Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant
Dim ReplaceCount As Integer

Set tbl = Worksheets("Sheet1").ListObjects("Arpana_Table")

  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)
 
  fndList = 1
  rplcList = 2
ReplaceCount = 0

  For x = LBound(myArray, 1) To UBound(myArray, 2)
   
      For Each sht In ActiveWorkbook.Worksheets
        If sht.Name <> tbl.Parent.Name Then
       
          ReplaceCount = ReplaceCount + Application.CountIf(sht.Cells, "*" & myArray(fndList, x) & "*")
         
          sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
       
        End If
      Next sht
  Next x
MsgBox "Completed - " & ReplaceCount
End Sub
 
You guys might looking for this.

Code: 
Sub Find_Replace2()
Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant
Dim ReplaceCount As Integer

Set tbl = Worksheets("Sheet1").ListObjects("Arpana_Table")

  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)
  fndList = 1
  rplcList = 2
ReplaceCount = 0

  For x = LBound(myArray, 1) To UBound(myArray, 2)
 
      For Each sht In ActiveWorkbook.Worksheets
        If sht.Name <> tbl.Parent.Name Then
     
          ReplaceCount = ReplaceCount + Application.CountIf(sht.UsedRange, "*" & myArray(fndList, x) & "*")
       
          sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
     
        End If
      Next sht
  Next x

If ReplaceCount > 0 Then
    MsgBox "Completed - " & ReplaceCount
Else
MsgBox "No Action Taken"
End If

End Sub
 
I think This one is more dynamic...

Choose as required..

Code: 
Sub Find_Replace2()
Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant
Dim ReplaceCount As Integer
Dim RCount() As Variant, bCheck As Boolean

Set tbl = Worksheets("Sheet1").ListObjects("Arpana_Table")

  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)
    fndList = 1
    rplcList = 2
    ReDim RCount(UBound(myArray, 2) + 1)
    bCheck = False
   
For x = LBound(myArray, 1) To UBound(myArray, 2)
    ReplaceCount = 0
        For Each sht In ActiveWorkbook.Worksheets
            If sht.Name <> tbl.Parent.Name Then
                ReplaceCount = ReplaceCount + Application.CountIf(sht.UsedRange, "*" & myArray(fndList, x) & "*")
                    sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
                        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                            SearchFormat:=False, ReplaceFormat:=False
            End If
            If Not bCheck Then bCheck = (ReplaceCount > 0)
        Next sht
    RCount(x) = myArray(fndList, x) & " - " & myArray(rplcList, x) & " - " & ReplaceCount
Next x

If bCheck Then
    MsgBox "Completed as below!!" & vbCrLf & _
    Join(RCount, vbCrLf)
Else
MsgBox "No Action Taken"
End If

End Sub
 
Hello Deepak Excel Ninja

I really don't know, how to thank you...You are super.

It works as per my requirment.

Thanks monty too.

Deepak said:
I think This one is more dynamic...

Choose as required..

Code: 
Sub Find_Replace2()
Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant
Dim ReplaceCount As Integer
Dim RCount() As Variant, bCheck As Boolean

Set tbl = Worksheets("Sheet1").ListObjects("Arpana_Table")

  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)
    fndList = 1
    rplcList = 2
    ReDim RCount(UBound(myArray, 2) + 1)
    bCheck = False
  
For x = LBound(myArray, 1) To UBound(myArray, 2)
    ReplaceCount = 0
        For Each sht In ActiveWorkbook.Worksheets
            If sht.Name <> tbl.Parent.Name Then
                ReplaceCount = ReplaceCount + Application.CountIf(sht.UsedRange, "*" & myArray(fndList, x) & "*")
                    sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
                        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
                            SearchFormat:=False, ReplaceFormat:=False
            End If
            If Not bCheck Then bCheck = (ReplaceCount > 0)
        Next sht
    RCount(x) = myArray(fndList, x) & " - " & myArray(rplcList, x) & " - " & ReplaceCount
Next x

If bCheck Then
    MsgBox "Completed as below!!" & vbCrLf & _
    Join(RCount, vbCrLf)
Else
MsgBox "No Action Taken"
End If

End Sub
Click to expand...
 
Glad to know that it helped you....

@Monty - Pls don't start a new thread just to attract attention, we will happy to help at original thread.

@Arpanakumar - Pls try to skip the words like as urgent as we are volunteers here and enjoying by helping. Every thread equally important for us regardless the OP's priorities. You may inbox the one to get it solved on priority by paying a charge.

By the way have fun....
 
Deepak said:
Glad to know that it helped you....

@Monty - Pls don't start a new thread just to attract attention, we will happy to help at original thread.

@Arpanakumar - Pls try to skip the words like as urgent as we are volunteers here and enjoying by helping. Every thread equally important for us regardless the OP's priorities. You may inbox the one to get it solved on priority by paying a charge.

By the bay have fun....
Click to expand...
Noted!!!
 
You must log in or register to reply here.
Back
Top