VBA to see if a column contains a certain string

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
17,972
Office Version
2013
Platform
Windows
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

Well-known Member
Joined
Aug 14, 2018
Messages
1,039
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

Well-known Member
Joined
Oct 27, 2005
Messages
17,972
Office Version
2013
Platform
Windows
Ok, if the search starts in F4, change to

Code:
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

Well-known Member
Joined
Aug 14, 2018
Messages
1,039
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?

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
            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

Well-known Member
Joined
Aug 14, 2018
Messages
1,039
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

Well-known Member
Joined
Oct 27, 2005
Messages
17,972
Office Version
2013
Platform
Windows
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

Well-known Member
Joined
Aug 14, 2018
Messages
1,039
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

Well-known Member
Joined
Aug 14, 2018
Messages
1,039
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

Well-known Member
Joined
Oct 27, 2005
Messages
17,972
Office Version
2013
Platform
Windows
try changing the cell reference ( in red) to say F1
Also, this code is Case sensitive, so "Yir" can't be "YIR" or "yir"

Code:
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

Well-known Member
Joined
Aug 14, 2018
Messages
1,039
  • 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).
 

Forum statistics

Threads
1,078,285
Messages
5,339,287
Members
399,291
Latest member
Bdbd55

Some videos you may like

This Week's Hot Topics

Top