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

 

[Momentman]

Like this maybe

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
                cfind.Value = cfind.Value & cfind.Offset(0, 1).Value
            
            End If
Nextcel:
    Next cel
End Sub

 

[dgr]

Thanks a lot Momentman. This was exactly what I was looking for. I truly appreciate your help. Have a good day.

 

[Rick Rothstein]

Thanks a lot Momentman. This was exactly what I was looking for. I truly appreciate your help. Have a good day.

If the active worksheet's used range consists of only data (no formulas), then his non-looping macro will also work...

Sub test()
  Dim Addr As String
  Addr = ActiveSheet.UsedRange.Address
  With Range(Addr)
    .Replace "*hello*", "#""hello""&RC[1]", xlWhole, , False
    .FormulaR1C1 = Evaluate(Replace("IF(LEFT(@)=""#"",SUBSTITUTE(@,""#"",""=""),IF(LEN(@),@,""""))", "@", Addr))
    .Value = .Value
  End With
End Sub

 

[dgr]

Thanks Rick. I suppose that a non-looping version would be more efficient than a looping version?

 

[Rick Rothstein]

Thanks Rick. I suppose that a non-looping version would be more efficient than a looping version?

I haven't tested it for speed, but I think it may be faster. I'll test it later when I get a chance to set up a large worksheet.

 

[Rick Rothstein]

I haven't tested it for speed, but I think it may be faster. I'll test it later when I get a chance to set up a large worksheet.

Actually, in my test of 500,000 cells with 500 of them containin "hello" somewhere, my previously posted code failed (too many cells for the Evaluate function), so I rewrote my code as follows..

Sub test()
  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
      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

This code is about as fast as you could probably find... it took 1.15 seconds on my (relatively fast computer) to make the changes in those 500 cells from among the total of 1/2 million cells... by comparison, Momentman's code took 9.83 seconds to process the same data.

 

[mikerickson]

I don't think that one has to loop though every cell in the sheet. Although Ricks looping through array elements might be quicker.

Sub test()
    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
            .Value = .Value & CStr(.Offset(0, 1).Value)
        End With
        Set foundCell = Cells.FindNext(after:=foundCell)
    Loop Until foundCell.Address = firstFoundAddress
End Sub

 

[Rick Rothstein]

I don't think that one has to loop though every cell in the sheet. Although Ricks looping through array elements might be quicker.

Sub test()
    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
            .Value = .Value & CStr(.Offset(0, 1).Value)
        End With
        Set foundCell = Cells.FindNext(after:=foundCell)
    [COLOR=#FF0000][B]Loop Until foundCell.Address = firstFoundAddress[/B][/COLOR]
End Sub

I tried to time test your code but ran into a problem. I tried several times and your code errored out on the highlighted line of code above, each time at a different fountCell.Address, with the error message (not sure I ever saw this before from running code)... "Code execution has been interrupted". Somehow the 1/2 a million cells is overwhelming your code???

 

[mikerickson]

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