VBA to find a cell in a specific column that contains text which includes a specific word

[Phil Payne]

Hello all,

I'm struggling again and hope our forum can provide a solution!

I need to find a cell in a specific column that contains text which includes a specific word and when found, copy the found cell contents into 5 cells immediately to the right of the found cell.

Solutions found by 'googling' mostly describe searching a single cell or employing a user form that I cannot use or translate into what I need!

My worksheet layout is shown here, I need to find "Total" in column B. Row number 15017 (ID15016) "Site 1 Total" is example of what I wish to achieve! (The '5 cells' C to G are empty at start.)

1	A	B	C	D	E	F	G	H
15009	15008	Site 1	17183493	ROOFING WORKS - FELT (INSULATED)	W5450	Sill boards Ne 200 mm wide	28.95	__
15010	15009	Site 1	17183493 Total	ROOFING WORKS - FELT (INSULATED)				£9,999.00
15011	15010	Site 1	17183503	PRELIMS	FIXPRSU	FIXED PRICE SUB	400	__
15012	15011	Site 1	17183503	PRELIMS	Q1010	Labour only recovery	488	__
15013	15012	Site 1	17183503	PRELIMS	Q1015	Mechanical Plant Hire	16085	__
15014	15013	Site 1	17183503	PRELIMS	Z0960	Provide static guard (night ra	701	__
15015	15014	Site 1	17183503	PRELIMS	Z0965	Provide static guard (week-end	384	__
15016	15015	Site 1	17183503 Total	PRELIMS				£8,888.00
15017	15016	Site 1 Total	Site 1 Total	Site 1 Total	Site 1 Total	Site 1 Total	Site 1 Total	£18,887.00
15018	15017	Site 2	16562582	CARRY OUT LEAD PAINT SURVEYS	VAL005	CB valuations recovery	0.41	__
15019	15018	Site 2	16562582 Total	CARRY OUT LEAD PAINT SURVEYS				£7,777.00
15020	15019	Site 2	16651990	INSTALL WIRELESS FIRE ALARM	FIXPRSU	FIXED PRICE SUB	35824.57	__
15021	15020	Site 2	16651990	INSTALL WIRELESS FIRE ALARM	VAL005	CB valuations recovery	4.3	__
15022	15021	Site 2	16651990 Total	INSTALL WIRELESS FIRE ALARM				£6,666.00

<tbody>
</tbody>

Thanks very much.

Phil.

 

[Osvaldo Palmeiro]

Hello. Phil. Try this:
It's supposed there will be only one word "Total" in column "B" as you'll run the code.

Sub FindTotal()
 Dim rngT As Range
  Set rngT = ActiveSheet.Columns(2).Find("Total", lookat:=xlPart)
   If Not rngT Is Nothing Then
     ActiveSheet.Cells(rngT.Row, 3).Resize(, 5).Value = rngT.Value
   End If
End Sub

 

[draycut]

Hi Does This code work for you?

Sub CopyTotal()    Dim i As Long, LastRow As Long
    Dim ws1 As Worksheet


    Set ws1 = ThisWorkbook.Sheets(1)
    
    LastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To LastRow
        
        If Range("B" & i).Text Like "*Total*" Then
            Range("B" & i).Copy Destination:=Range("C" & i)
            Range("B" & i).Copy Destination:=Range("D" & i)
            Range("B" & i).Copy Destination:=Range("E" & i)
            Range("B" & i).Copy Destination:=Range("F" & i)
            Range("B" & i).Copy Destination:=Range("G" & i)
        End If
    Next i
End Sub

 

[Phil Payne]

Hello. Phil. Try this:
It's supposed there will be only one word "Total" in column "B" as you'll run the code.

Sub FindTotal()
 Dim rngT As Range
  Set rngT = ActiveSheet.Columns(2).Find("Total", lookat:=xlPart)
   If Not rngT Is Nothing Then
     ActiveSheet.Cells(rngT.Row, 3).Resize(, 5).Value = rngT.Value
   End If
End Sub

Thanks very much for the prompt response Osvaldo.
I've chosen to go with Draycuts solution as I can see the column Letters in the code. (Im not very expert at this)
Thanks again.

 

[Phil Payne]

Thanks draycut.

Worked first time.

Excellent!

 

[draycut]

Cool, glad I could help