VBA to see if a column contains a certain string

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,352
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I need code to check if a cell in column F contains certain text. I then need to apply colour formatting to the entire row. Can someone help me please?
 
Last edited:
thinking !!!

OK, replace the code that is giving us problems with the original code I posted
Put it in the same location

Code:
Sub MM1()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "F").End(xlUp).Row
For r = 1 To lr
    If Range("F" & r).Value = "Yir" Then
       Range("F" & r).EntireRow.font.ColorIndex = 3
    End If
Next r
End Sub
 
Last edited:
Upvote 0

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Thanks for all this help Michael,

I put that code in and no colours got changed. I ran it a second time and got the error subscript out of range with this line highlighted

Code:
Range("F" & r).EntireRow.Font.ColorIndex = -65383

This is my total procedure:

Code:
Sub cmdCopy()
        Dim wsDst As Worksheet, wsSrc As Worksheet, tblrow As ListRow
        Dim Combo As String, sht As Worksheet, tbl As ListObject
        Dim LastRow As Long, DocYearName As String, lr As Long
        Dim RowColor As Long, w As Window, r As Long
            Application.ScreenUpdating = False
        'assign values to variables
        Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
        Set sht = ThisWorkbook.Worksheets("Costing_tool")
        For Each tblrow In tbl.ListRows
            If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
                MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
                Exit Sub
            End If
        Next tblrow
        For Each tblrow In tbl.ListRows
            Combo = tblrow.Range.Cells(1, 26).Value
                Select Case tblrow.Range.Cells(1, 6).Value
                    Case "Yir"
                        DocYearName = tblrow.Range.Cells(1, 37).Value
                    Case "Ang Wes", "Ang Riv"
                        DocYearName = tblrow.Range.Cells(1, 37).Value
                    Case Else
                        DocYearName = tblrow.Range.Cells(1, 36).Value
                End Select
            If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & DocYearName & ".xlsm"

            Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
            lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
            With wsDst
                    'This copies the first 16 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                    tblrow.Range.Resize(, 16).Copy
                    'This pastes in the figures in the first 10 columns starting in column A
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
                    'Overwrites the numbers pasted to column I with a formula
                    .Range("I" & .Range("I" & .Rows.Count).End(xlUp).Row).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
                    'Overwrites the numbers pasted to column J with a formula
                    .Range("J" & .Range("J" & .Rows.Count).End(xlUp).Row).Formula = "=RC[-1]+RC[-2]"

                        lr = Cells(Rows.Count, "F").End(xlUp).Row
                        For r = 1 To lr
                            If Range("F" & r).Value = "Yir" Then
                               Range("F" & r).EntireRow.Font.ColorIndex = -65383
                            End If
                        Next r
                    'sort procedure copied from vba
                    wsDst.Sort.SortFields.Clear
                    wsDst.Sort.SortFields.Add Key:=Range("A4:A" & lr), _
                        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                            With Workbooks(DocYearName).Worksheets(Combo).Sort
                                .SetRange Range("A3:AK" & lr)
                                .header = xlYes
                                .MatchCase = False
                                .Orientation = xlTopToBottom
                                .SortMethod = xlPinYin
                                .Apply
                            End With
            End With
        Next tblrow
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Why did you modify this line ?
Code:
Range("F" & r).EntireRow.Font.ColorIndex = -65383

colorindex needs to be a number between 1 - 56, although it is probably a greater number on later versions !!
 
Upvote 0
try this slight mod

Code:
lr = .Cells(Rows.Count, "F").End(xlUp).Row
       For r = 1 To lr
           If .Range("F" & r).Value = "Yir" Then .Range("F" & r).EntireRow.Font.ColorIndex = 3
       Next r
 
Upvote 0
That seems to have worked, thank you so much Michael :)
 
Upvote 0
Just noticed that is has appeared to have changed the colour of every cell in column F of the source workbook to be blue, where the rows around it are alternate colours. How can I make it the same as the rows around it?
 
Upvote 0
what colour are the rows around it ??
 
Upvote 0
White and light blue that appears to be the standard colour of a table.
 
Upvote 0
The code I provided should only affect the Dest worksheet AND only the font, not the cell colour ??
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,923
Members
448,533
Latest member
thietbibeboiwasaco

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