Applying a Find and Replace macro to only cells highlighted in Red?

[dougmarkham]

Hi Folks,

I am working on an address book. I have some VBA code to look at any 'selected range' of cells within the address book; it then finds words within text strings that match words stored in another table (the findList)---stored in column A of table 1. If it finds words within the text string that match words in the findList, it replaces that word with the cognate words---stored in column B of table 1 (the replaceList).

E.g., Address database with cells selected (shown in blue)
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Company name[/TD]
[TD]Address line 1[/TD]
[TD]Address line 2[/TD]
[TD]Address line 3 etc[/TD]
[/TR]
[TR]
[TD]Chelsea and Westminster Hospital NHS Foundation Trust[/TD]
[TD]Chelsea and Westminster Hospital NHS Foundation Trust[/TD]
[TD]xyz Fulham Road[/TD]
[TD]London[/TD]
[/TR]
[TR]
[TD]Royal Liverpool and Broadgreen University Hospitals NHS Trust[/TD]
[TD]Royal Liverpool and Broadgreen University Hospital Trust[/TD]
[TD]Prescot Street[/TD]
[TD]Liverpool[/TD]
[/TR]
</tbody>[/TABLE]
Table 1: find and replace table
[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]findList[/TD]
[TD]replaceList[/TD]
[/TR]
[TR]
[TD]Royal[/TD]
[TD]ROY[/TD]
[/TR]
[TR]
[TD]University[/TD]
[TD]Uni[/TD]
[/TR]
[TR]
[TD]Hospital[/TD]
[TD]Hosp[/TD]
[/TR]
[TR]
[TD]NHS Foundation Trust[/TD]
[TD]NHS Trust[/TD]
[/TR]
</tbody>[/TABLE]








My address workbook has some vba working to identify cells in the address database worksheet with greater than 50 characters: it highlights those cells Red. What I would like to do is modify my find and replace VBA code to only search, find and replace text within cells highlighted in Red?

Here is my current search, find and replace VBA code:

Sub Multi_FindReplace25()

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


Application.ScreenUpdating = False
Application.Calculation = xlManual


'Create variable to point to your table
  Set tbl = Worksheets("Abbrev").ListObjects("Table25")


'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)
         [COLOR=#006400] [B]Selection.Replace[/B][/COLOR] what:=myArray(fndList, x), replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
  Next x
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Would anybody be willing to help me modify this VBA to only search cells in the address database that are highlighted in Red?

Kind regards,

Doug.

P.S. the worksheet with the address database is called: addDB

 

[Rick Rothstein]

(Untested) Here is your code with the changes highlighted in red...

[table="width: 500"]
[tr]
	[td]Sub Multi_FindReplace25()

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


Application.ScreenUpdating = False
Application.Calculation = xlManual


'Create variable to point to your table
  Set tbl = Worksheets("Abbrev").ListObjects("Table25")


'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

[B][COLOR="#FF0000"]'Set the Find function's color search for red
  Application.FindFormat.Clear
  Application.FindFormat.Interior.Color = vbRed[/COLOR][/B]

'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)
          Selection.Replace what:=myArray(fndList, x), replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=[B][COLOR="#FF0000"]True[/COLOR][/B], ReplaceFormat:=False
  Next x

[B][COLOR="#FF0000"]'Clear the Find function's color search criteria so it dos not interfere with future searches
  Application.FindFormat.Clear
[/COLOR][/B]
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
[/td]
[/tr]
[/table]

 

[dougmarkham]

(Untested) Here is your code with the changes highlighted in red...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub Multi_FindReplace25()

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


Application.ScreenUpdating = False
Application.Calculation = xlManual


'Create variable to point to your table
  Set tbl = Worksheets("Abbrev").ListObjects("Table25")


'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

[B][COLOR=#FF0000]'Set the Find function's color search for red
  Application.FindFormat.Clear
  Application.FindFormat.Interior.Color = vbRed[/COLOR][/B]

'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)
          Selection.Replace what:=myArray(fndList, x), replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=[B][COLOR=#FF0000]True[/COLOR][/B], ReplaceFormat:=False
  Next x

[B][COLOR=#FF0000]'Clear the Find function's color search criteria so it dos not interfere with future searches
  Application.FindFormat.Clear
[/COLOR][/B]
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Hi Rick,

This is just the ticket! Thanks for helping me.

Currently I'm looking to find a good resource to improve my VBA. I was wondering how you learnt about VBA (as you seem quite adept)?

Kind regards,

Doug.

 

[Rick Rothstein]

Hi Rick,

Currently I'm looking to find a good resource to improve my VBA. I was wondering how you learnt about VBA (as you seem quite adept)?

I am the wrong person to ask about learning VBA as I am completely self-taught and grew into VBA from its predecessor programming languages BASIC and Visual Basic (compiled version). I starting my programming "career" in 1981 and have literally written code every day since. One of my fellow contributors on this forum compiled a list of VB learning resources that may help you out though...

https://www.mrexcel.com/forum/excel...w-use-vbulletin-excel-2007-a.html#post4760720

 

[dougmarkham]

I am the wrong person to ask about learning VBA as I am completely self-taught and grew into VBA from its predecessor programming languages BASIC and Visual Basic (compiled version). I starting my programming "career" in 1981 and have literally written code every day since. One of my fellow contributors on this forum compiled a list of VB learning resources that may help you out though...

https://www.mrexcel.com/forum/excel...w-use-vbulletin-excel-2007-a.html#post4760720

Thanks for the link Rick,

It frustrates me that I am so limited in my coding ability, so these tutorials will be a great help. I am also mostly teaching myself as part of my duties..

Kind regards,

Doug.