VBA to see if a column contains a certain string

[dpaton05]

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?

 

[Michael M]

The search is supposed to start at F2 isn't it ??
If there is no value of "Yir" in the column what error do you get ??

 

[dpaton05]

It starts in F4 and it was giving me an error but now it isn't. Anyway Michael, I need to go now so I will continue on Wednesday when I am back at work.

Thanks.

 

[Michael M]

Ok, if the search starts in F4, change to

With .Range("F4:F" & Cells(Rows.Count, "F").End(xlUp).Row)
          .AutoFilter Field:=1, Criteria1:="Yir"
          .Range("F4:F" & Cells(Rows.Count, "F").End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Font.Color = -6538
          .AutoFilter
End With

If F4 is the header row, change the code to F5

 

[dpaton05]

Thanks Michael,

Did I put the code in the right spot as this is my code and it doesn't appear to change the colour?

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
            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]"
                        With .Range("F4:F" & Cells(Rows.Count, "F").End(xlUp).Row)
                                  .AutoFilter Field:=1, Criteria1:="Yir"
                                  .Range("F4:F" & Cells(Rows.Count, "F").End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Font.Color = -6538
                                  .AutoFilter
                        End With
                    '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

 

[dpaton05]

I would go with conditional formatting on this one.

Let's say that you have data in range A1:F100. And let's imagine that that you have a header row. Let's also say that you have the value that you want to search for in cell H1. Then you would select A2:F100, go to conditional formatting, add a rule, select use a formula, enter this formula =$F2=$H$1, choose whatever format you want, then apply the rule. This way all you have to do is type in a new value into H1 and the new matching rows will be highlighted.

Just realised that I cannot have conditional formatting as that would require formatting the actual document that the rows will be copied to, but I need it to be formatted from the original document where the rows will be coming from. Therefore, best to use vba to do that and I can put it in the copy procedure.

 

[Michael M]

Have you stepped through the code using F8 to make sure
1. the code autofilters correctly
2. there are visible rows to be coloured

 

[dpaton05]

Actually Michael, it is working but it won't colour the first row if, but will colour additional rows. When I first tested it, I only tried to copy 1 row, so I didn't realise that it was partially working.

In the destination workbook, the header row is row 3 with the data starting in row 4 and it is a range, not a table. In the source workbook, the header row is in row 4 and the data starts in row 5. The data is coming from a table in the source workbook to a range in the destination workbook.

 

[dpaton05]

I just tried having one row already in the destination wb and then ran the copy procedure and the first row to be copied across was not coloured but additional rows were. Therefore, the first 2 rows were not coloured, despite having the text Yir.

 

[Michael M]

try changing the cell reference ( in red) to say F1
Also, this code is Case sensitive, so "Yir" can't be "YIR" or "yir"

With .Range("F[color=red]4[/color]:F" & Cells(Rows.Count, "F").End(xlUp).Row)
          .AutoFilter Field:=1, Criteria1:="Yir"
          .Range("F[color=red]4[/color]:F" & Cells(Rows.Count, "F").End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Font.Color = -6538
          .AutoFilter
End With

 

[dpaton05]

• With all these tests, I have 4 rows in my source table with the first 3 rows (4-6) having Yir in column F and the forth row (7) has something else.
• If I change it to F1, the heading at the top of the page will change colour only.
• If I change it to F2, the first row of data in row 4 will change colour only.
• If I change it to F3, everything but the first row of data will change colour. That is the heading in row 1, the row headers in row 3 and the data from rows 5-7. This doesn't distinguish between having the text Yir in it, it colours everything.
• If I change it to F4, the first row of data in row 4 is not coloured, rows 5-6 are coloured and row 7 is not. This appears to be working except the first row, as the 7th row doesn't have Yir in column F. I ran the copy procedure again to see what happened and it coloured every new row that was added (8-11).