Find/Replace All Within A Specific Worksheet
Sub FindReplaceAll()
'PURPOSE: Find & Replace text/values throughout a specific sheet
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
fnd = "April"
rplc = "May"
'Store a specfic sheet to a variable
Set sht = Sheets("Sheet1")
'Perform the Find/Replace All
sht.Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
End Sub
Find/Replace All Throughout Entire Workbook
Sub FindReplaceAll()
'PURPOSE: Find & Replace text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
fnd = "April"
rplc = "May"
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
End Sub
Multiple Iterations of Find/Replace At Once!
If you need to perform a bunch of find and replace actions at once, you can use Arrays to store your
values.
Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
fndList = Array("Canada", "United States", "Mexico")
rplcList = Array("CAN", "USA", "MEX")
'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
Multiple Iterations of Find/Replace At Once (Feeding From A Table)
You can also read my post describing how you can populate your Array variables from an Excel
spreadsheet Table if you already have you list handy on your spreadsheet (sometimes it can be a pain
typing all your values out inside your VBA code). Below is an example of how this can be accomplished.
Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook from a table
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant
'Create variable to point to your table
Set tbl = Worksheets("Sheet1").ListObjects("Table1")
'Create an Array out of the Table's Data
Set TempArray = tbl.DataBodyRange
myArray = Application.Transpose(TempArray)
'Designate Columns for Find/Replace data
fndList = 1
rplcList = 2
'Loop through each item in Array lists
For x = LBound(myArray, 1) To UBound(myArray, 2)
'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
For Each sht In ActiveWorkbook.Worksheets
If sht.Name <> tbl.Parent.Name Then
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
End Sub
Notifying How Many Cells Were Changed
You may find yourself wanting to report out how many changes were made after your code has run. You
can accomplish this by using the COUNTIF() function to count how many cells contain your Find value
before you actually perform your find & replace.
The one downside to using the COUNTIF() function is it will not count multiple occurrences within a
single cell. I could not figure out a way around this and if you know of a way to accomplish this please let
me know in the comments section (this article might point you in the right direction).
Sub FindReplaceAll_CountReplacements()
'PURPOSE: Find & Replace text/values throughout entire workbook, notify user of how many cells were
affected
'SOURCE: www.TheSpreadsheetGuru.com
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
Dim ReplaceCount As Long
fnd = "April"
rplc = "May"
For Each sht In ActiveWorkbook.Worksheets
ReplaceCount = ReplaceCount + Application.WorksheetFunction.CountIf(sht.Cells, "*" & fnd & "*")
sht.Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
MsgBox "I have completed my search and made replacements in " & ReplaceCount & " cell(s)."
End Sub
Sub qwerty()
Dim rFirst As Range, r As Range
Dim A As Range
Set A = Range("A:A")
Do
If rFirst Is Nothing Then
Set rFirst = A.Find(What:=1, After:=A(1))
Set r = rFirst
Else
Set r = A.Find(What:=1, After:=r)
If r.Address = rFirst.Address Then Exit Do
End If
MyString = MyString & " " & r.Offset(0, 1)
Loop
MsgBox MyString
End Sub
You need to call Find once, and then successively FindNext
Dim rng As Excel.Range
Set rng = ActiveWorkbook.Worksheets("sheet1").Range("F1:F1000000")
Set cellFound = rng.Find("1")
Do While Not cellFound Is Nothing
Set cellFound = rng.FindNext
Loop
