Find Text, Concatenate It With Cell on Immediate Right

[dgr]

Hi,

I'm using Excel 2013. I want to find the word "hello" anywhere in a worksheet. After finding "hello" I want to concatenate this cell with the cell on the immediate right.

I've written the code below halfway to give you an understanding of the logic. However, I don't know how to complete the code. Please help. Thanks.

Sub test()
Dim cel As Range, cfind As Range

For Each cel In ActiveSheet.UsedRange
If cel = "" Then GoTo nextcel
Set cfind = cel.Find("hello", , xlValues, xlPart, xlRows, xlNext, False)
If Not cfind Is Nothing Then

'I don't know what to do here

End If

nextcel:
Next cel
End Sub

 

[Rick Rothstein]

At 5,000,000 cells (24 hellos), my code was pretty darn slow. I'd say Ricks is the stable/fastest.

I don't understand why I could not get your code to finish execution with just 10% that number of cells (way more "hellos" though)? I did try modifying your Loop statement (to what the Find method's help file example showed), but it made no difference... the code still errored out at differing foundCell locations.

 

[mikerickson]

I can't reproduce the error. I can sit and wait a long time for .Find to search through non-matches, but I can't get an error.

 

[dgr]

Dear Helpful People,
I ran into a new problem. All 3 versions of the code worked fine on my initial sample of 900+ records. I tried the code on a new batch of 1000+ records. All 3 versions failed. Obviously there is something about my data that is causing all 3 versions to fail. However, since the word "hello" is located all over the worksheet, it's difficult to look at every single occurrence of the word "hello" to demystify the issue.

Here is where the codes failed:

Sub momentman()

  Dim cel As Range, cfind As Range
    
    For Each cel In ActiveSheet.UsedRange

'THE LINE BELOW IS YELLOW
        If cel = "" Then GoTo Nextcel
            Set cfind = cel.Find("hello", , xlValues, xlPart, xlRows, xlNext, False)
            If Not cfind Is Nothing Then
                cfind.Value = cfind.Value & cfind.Offset(0, 1).Value
            
            End If
Nextcel:
    Next cel
    
End Sub

Sub Rick_Rothstein()

  Dim R As Long, C As Long, Data As Variant
  Data = ActiveSheet.UsedRange
  For R = 1 To UBound(Data)
    For C = 1 To UBound(Data, 2) - 1

'THE LINE BELOW IS YELLOW
      If InStr(1, Data(R, C), "hello", vbTextCompare) Then Data(R, C) = Data(R, C) & Data(R, C + 1)
    Next
  Next
  ActiveSheet.UsedRange = Data
  
End Sub

Sub mikerickson()

Dim foundCell As Range
    Dim firstFoundAddress As String
    
    Set foundCell = ActiveSheet.Cells.Find("hello", after:=Cells(1, 1), LookIn:=xlValues, _
        LookAt:=xlPart, Searchdirection:=xlNext, MatchCase:=False)
    
    If Not foundCell Is Nothing Then
        firstFoundAddress = foundCell.Address
    End If
    
    Do
        With foundCell

'THE LINE BELOW IS YELLOW
            .Value = .Value & CStr(.Offset(0, 1).Value)
        End With
        Set foundCell = Cells.FindNext(after:=foundCell)
    Loop Until foundCell.Address = firstFoundAddress
  
End Sub

Is there something that can be added in any of these codes to make it more reliable? Thanks a lot.