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

Phil Payne

Phil Payne

Board Regular
Joined
May 17, 2013
Messages
131
Office Version
  1. 365
Platform
  1. Windows
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.)

[TABLE="width: 667"]
<tbody>[TR]
[TD="width: 42, bgcolor: #D9D9D9"]1[/TD]
[TD="width: 49, bgcolor: #D9D9D9"]A[/TD]
[TD="width: 60, bgcolor: #D9D9D9"]B[/TD]
[TD="width: 81, bgcolor: #D9D9D9"]C[/TD]
[TD="width: 241, bgcolor: #D9D9D9"]D[/TD]
[TD="width: 68, bgcolor: #D9D9D9"]E[/TD]
[TD="width: 191, bgcolor: #D9D9D9"]F[/TD]
[TD="width: 73, bgcolor: #D9D9D9"]G[/TD]
[TD="width: 82, bgcolor: #D9D9D9"]H[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15009[/TD]
[TD="bgcolor: transparent, align: right"]15008[/TD]
[TD="bgcolor: transparent"]Site 1[/TD]
[TD="bgcolor: transparent"]17183493[/TD]
[TD="bgcolor: transparent"]ROOFING WORKS - FELT (INSULATED)[/TD]
[TD="bgcolor: transparent"]W5450[/TD]
[TD="bgcolor: transparent"]Sill boards Ne 200 mm wide[/TD]
[TD="bgcolor: transparent"]28.95[/TD]
[TD="bgcolor: transparent"]__[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15010[/TD]
[TD="bgcolor: transparent, align: right"]15009[/TD]
[TD="bgcolor: transparent"]Site 1[/TD]
[TD="bgcolor: #FFFF99"]17183493 Total[/TD]
[TD="bgcolor: #FFFF99"]ROOFING WORKS - FELT (INSULATED)[/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"]£9,999.00[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15011[/TD]
[TD="bgcolor: transparent, align: right"]15010[/TD]
[TD="bgcolor: transparent"]Site 1[/TD]
[TD="bgcolor: transparent"]17183503[/TD]
[TD="bgcolor: transparent"]PRELIMS[/TD]
[TD="bgcolor: transparent"]FIXPRSU[/TD]
[TD="bgcolor: transparent"]FIXED PRICE SUB[/TD]
[TD="bgcolor: transparent"]400[/TD]
[TD="bgcolor: transparent"]__[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15012[/TD]
[TD="bgcolor: transparent, align: right"]15011[/TD]
[TD="bgcolor: transparent"]Site 1[/TD]
[TD="bgcolor: transparent"]17183503[/TD]
[TD="bgcolor: transparent"]PRELIMS[/TD]
[TD="bgcolor: transparent"]Q1010[/TD]
[TD="bgcolor: transparent"]Labour only recovery[/TD]
[TD="bgcolor: transparent"]488[/TD]
[TD="bgcolor: transparent"]__[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15013[/TD]
[TD="bgcolor: transparent, align: right"]15012[/TD]
[TD="bgcolor: transparent"]Site 1[/TD]
[TD="bgcolor: transparent"]17183503[/TD]
[TD="bgcolor: transparent"]PRELIMS[/TD]
[TD="bgcolor: transparent"]Q1015[/TD]
[TD="bgcolor: transparent"]Mechanical Plant Hire[/TD]
[TD="bgcolor: transparent"]16085[/TD]
[TD="bgcolor: transparent"]__[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15014[/TD]
[TD="bgcolor: transparent, align: right"]15013[/TD]
[TD="bgcolor: transparent"]Site 1[/TD]
[TD="bgcolor: transparent"]17183503[/TD]
[TD="bgcolor: transparent"]PRELIMS[/TD]
[TD="bgcolor: transparent"]Z0960[/TD]
[TD="bgcolor: transparent"]Provide static guard (night ra[/TD]
[TD="bgcolor: transparent"]701[/TD]
[TD="bgcolor: transparent"]__[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15015[/TD]
[TD="bgcolor: transparent, align: right"]15014[/TD]
[TD="bgcolor: transparent"]Site 1[/TD]
[TD="bgcolor: transparent"]17183503[/TD]
[TD="bgcolor: transparent"]PRELIMS[/TD]
[TD="bgcolor: transparent"]Z0965[/TD]
[TD="bgcolor: transparent"]Provide static guard (week-end[/TD]
[TD="bgcolor: transparent"]384[/TD]
[TD="bgcolor: transparent"]__[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15016[/TD]
[TD="bgcolor: transparent, align: right"]15015[/TD]
[TD="bgcolor: transparent"]Site 1[/TD]
[TD="bgcolor: #FFFF99"]17183503 Total[/TD]
[TD="bgcolor: #FFFF99"]PRELIMS[/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"]£8,888.00[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15017[/TD]
[TD="bgcolor: transparent, align: right"]15016[/TD]
[TD="bgcolor: #92D050"]Site 1 Total[/TD]
[TD="bgcolor: #92D050"]Site 1 Total[/TD]
[TD="bgcolor: #92D050"]Site 1 Total[/TD]
[TD="bgcolor: #92D050"]Site 1 Total[/TD]
[TD="bgcolor: #92D050"]Site 1 Total[/TD]
[TD="bgcolor: #92D050"]Site 1 Total[/TD]
[TD="bgcolor: #92D050"]£18,887.00[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15018[/TD]
[TD="bgcolor: transparent, align: right"]15017[/TD]
[TD="bgcolor: transparent"]Site 2[/TD]
[TD="bgcolor: transparent"]16562582[/TD]
[TD="bgcolor: transparent"]CARRY OUT LEAD PAINT SURVEYS[/TD]
[TD="bgcolor: transparent"]VAL005[/TD]
[TD="bgcolor: transparent"]CB valuations recovery[/TD]
[TD="bgcolor: transparent"]0.41[/TD]
[TD="bgcolor: transparent"]__[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15019[/TD]
[TD="bgcolor: transparent, align: right"]15018[/TD]
[TD="bgcolor: transparent"]Site 2[/TD]
[TD="bgcolor: #FFFF99"]16562582 Total[/TD]
[TD="bgcolor: #FFFF99"]CARRY OUT LEAD PAINT SURVEYS[/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"]£7,777.00[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15020[/TD]
[TD="bgcolor: transparent, align: right"]15019[/TD]
[TD="bgcolor: transparent"]Site 2[/TD]
[TD="bgcolor: transparent"]16651990[/TD]
[TD="bgcolor: transparent"]INSTALL WIRELESS FIRE ALARM[/TD]
[TD="bgcolor: transparent"]FIXPRSU[/TD]
[TD="bgcolor: transparent"]FIXED PRICE SUB[/TD]
[TD="bgcolor: transparent"]35824.57[/TD]
[TD="bgcolor: transparent"]__[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15021[/TD]
[TD="bgcolor: transparent, align: right"]15020[/TD]
[TD="bgcolor: transparent"]Site 2[/TD]
[TD="bgcolor: transparent"]16651990[/TD]
[TD="bgcolor: transparent"]INSTALL WIRELESS FIRE ALARM[/TD]
[TD="bgcolor: transparent"]VAL005[/TD]
[TD="bgcolor: transparent"]CB valuations recovery[/TD]
[TD="bgcolor: transparent"]4.3[/TD]
[TD="bgcolor: transparent"]__[/TD]
[/TR]
[TR]
[TD="bgcolor: #D9D9D9, align: right"]15022[/TD]
[TD="bgcolor: transparent, align: right"]15021[/TD]
[TD="bgcolor: transparent"]Site 2[/TD]
[TD="bgcolor: #FFFF99"]16651990 Total[/TD]
[TD="bgcolor: #FFFF99"]INSTALL WIRELESS FIRE ALARM[/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"][/TD]
[TD="bgcolor: #FFFF99"]£6,666.00[/TD]
[/TR]
</tbody>[/TABLE]

Thanks very much.

Phil.
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
Hello. Phil. Try this:
It's supposed there will be only one word "Total" in column "B" as you'll run the code.


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
 
Upvote 0
Hi :) Does This code work for you?

Code: 
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
 
Upvote 0
Osvaldo Palmeiro said:
Hello. Phil. Try this:
It's supposed there will be only one word "Total" in column "B" as you'll run the code.


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
Click to expand...

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.
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top