VBA find and replace entire cell contents

[camspy]

Hello,

I am running Excel 2021 and I have a two sheets, here's Sheet1, it contains values of find (col A) and replace (col B), there might be 1k of rows in there:

Book1
	A	B
1	Abigail	<a href="https://example.com/abigail.html"><img src="https://example.com/abigail.jpg"> Abigail</a>
2	Sophia	<a href="https://example.com/sophia.html"><img src="https://example.com/sophia.jpg"> Sophia</a>
3	Amelia	<a href="https://example.com/amelia.html"><img src="https://example.com/amelia.jpg"> Amelia</a>
4	Elizabeth	<a href="https://example.com/elizabeth.html"><img src="https://example.com/elizabeth.jpg"> Elizabeth</a>
5	Ava	<a href="https://example.com/ava.html"><img src="https://example.com/ava.jpg"> Ava</a>
6	Isabella	<a href="https://example.com/isabella.html"><img src="https://example.com/isabella.jpg"> Isabella</a>
7	Gianna	<a href="https://example.com/gianna.html"><img src="https://example.com/gianna.jpg"> Gianna</a>
8	Harper	<a href="https://example.com/harper.html"><img src="https://example.com/harper.jpg"> Harper</a>
9	Mila	<a href="https://example.com/mila.html"><img src="https://example.com/mila.jpg"> Mila</a>
10	Olivia	<a href="https://example.com/olivia.html"><img src="https://example.com/olivia.jpg"> Olivia</a>
Sheet1

The cells in col B might get lengthy, like 1k characters long.

Sheet2 contains cells with contents that need get found and replaced using the data from Sheet1:

Book1
	A	B	C	D
1	Ava	Isabella	Olivia	Sophia
2	Isabella	Gianna	Abigail	Amelia
3	Gianna	Harper	Sophia	Elizabeth
4	Harper	Mila	Amelia	Mila
5	Mila	Olivia	Elizabeth	Olivia
6	Olivia	Abigail	Ava	Abigail
7	Abigail	Sophia	Isabella	Ava
8	Sophia	Amelia	Gianna	Isabella
9	Amelia	Elizabeth	Harper	Gianna
10	Elizabeth	Ava	Mila	Harper
Sheet2

There are like like 200 columns and 2k rows in Sheet2.

I was using some 10-year-old VBA code that stopped working in new Excel with long cell values and also it workes slow as heck.

Is it possible that some new VBA solution would work with long cell values (1k characters long) to use find and replace data from Sheet1 to change entire cell contents in Sheet2?
Any help is appreciated.
Thanks in advance.

 

[Micron]

I think I have it, based on the 1st answer here:

Find all matches in workbook using Excel VBA

I am trying to write a VBA routine that will take a string, search a given Excel workbook, and return to me all possible matches. I currently have an implementation that works, but it is extremel...

stackoverflow.com

but it's a mess right now.

 

[camspy]

It sounds hopeful
However I don't understand how to tweak your VBA with the one from stackoverflow

I think I have it, based on the 1st answer here:

Find all matches in workbook using Excel VBA

I am trying to write a VBA routine that will take a string, search a given Excel workbook, and return to me all possible matches. I currently have an implementation that works, but it is extremel...

stackoverflow.com

but it's a mess right now.

 

[Micron]

This seems to work except it doesn't do anything for Abigail. For some reason you've elected to start with row 2 of sheet1 as noted a couple of times, so that's why.

Sub MatchAndReplace2()
''this code is ignoring row 1 of sheet(3). Why?
Dim i As Long
Dim SearchString As String, ReplaceString As String
Dim SearchRange As Range, SearchResults As Range, rng As Range

Sheets(2).Copy After:=Sheets(2)
For i = 2 To ThisWorkbook.Sheets(1).Cells(1, 1).CurrentRegion.Rows.Count
   SearchString = ThisWorkbook.Sheets(1).Cells(i, 1).Text
   ReplaceString = ThisWorkbook.Sheets(1).Cells(i, 2).Text
   Set SearchRange = Sheets(3).UsedRange
   Set SearchResults = FindAll(SearchRange, ThisWorkbook.Sheets(1).Cells(i, 1).Text)
   If SearchResults Is Nothing Then
      'No match found
   Else
      For Each rng In SearchResults
         rng.Value = ReplaceString
      Next
   End If
Next

End Sub

Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, Optional SearchOrder As XlSearchOrder = xlByColumns, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
Dim SearchResult As Range
Dim firstMatch As String
With rng
   Set SearchResult = .Find(What, , LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
   If Not SearchResult Is Nothing Then
      firstMatch = SearchResult.Address
      Do
         If FindAll Is Nothing Then
            Set FindAll = SearchResult
         Else
            Set FindAll = Union(FindAll, SearchResult)
         End If
         Set SearchResult = .FindNext(SearchResult)
      Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstMatch
   End If
End With

End Function

 

[camspy]

I must admit that it works like it should.
Extremely slow, but it works.

Maybe turning off screen updating would make it work a little faster?

I've read that this would do the trick, I just have no clue where exactly to add it:

Application.ScreenUpdating = False

This seems to work except it doesn't do anything for Abigail. For some reason you've elected to start with row 2 of sheet1 as noted a couple of times, so that's why.

Sub MatchAndReplace2()
''this code is ignoring row 1 of sheet(3). Why?
Dim i As Long
Dim SearchString As String, ReplaceString As String
Dim SearchRange As Range, SearchResults As Range, rng As Range

Sheets(2).Copy After:=Sheets(2)
For i = 2 To ThisWorkbook.Sheets(1).Cells(1, 1).CurrentRegion.Rows.Count
   SearchString = ThisWorkbook.Sheets(1).Cells(i, 1).Text
   ReplaceString = ThisWorkbook.Sheets(1).Cells(i, 2).Text
   Set SearchRange = Sheets(3).UsedRange
   Set SearchResults = FindAll(SearchRange, ThisWorkbook.Sheets(1).Cells(i, 1).Text)
   If SearchResults Is Nothing Then
      'No match found
   Else
      For Each rng In SearchResults
         rng.Value = ReplaceString
      Next
   End If
Next

End Sub

Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, Optional SearchOrder As XlSearchOrder = xlByColumns, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
Dim SearchResult As Range
Dim firstMatch As String
With rng
   Set SearchResult = .Find(What, , LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
   If Not SearchResult Is Nothing Then
      firstMatch = SearchResult.Address
      Do
         If FindAll Is Nothing Then
            Set FindAll = SearchResult
         Else
            Set FindAll = Union(FindAll, SearchResult)
         End If
         Set SearchResult = .FindNext(SearchResult)
      Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstMatch
   End If
End With

End Function

 

[Micron]

I'm not surprised it's slow for you. After spending hours on the solution I'm not game for trying to use one or more arrays, mainly because arrays are not one of my strongest points. Might not be applicable anyway. However, see what happens with your suggestion: perhaps disable right after this
Sheets(2).Copy After:=Sheets(2)
and enable before this
End Sub
I think I'd use an error handler lest updating get turned off and not back on, but can't look at that now. You could research error handling and see what you think.

 

[camspy]

It works, thank you very much!

I'm not surprised it's slow for you. After spending hours on the solution I'm not game for trying to use one or more arrays, mainly because arrays are not one of my strongest points. Might not be applicable anyway. However, see what happens with your suggestion: perhaps disable right after this
Sheets(2).Copy After:=Sheets(2)
and enable before this
End Sub
I think I'd use an error handler lest updating get turned off and not back on, but can't look at that now. You could research error handling and see what you think.

 

[Micron]

So what speed improvement did you get by doing that?
Are you able to mark this one as solved?

 

[camspy]

Yes, I've marked your last script as solved.

I can't really say how much faster the last tweak with screen updating was, I wasn't tracking the processing time

So what speed improvement did you get by doing that?
Are you able to mark this one as solved?