FindFormat Help.

[Baziwan]

Hi all,

I have a table that has multiple matching entries and i'm trying to use .find to get the right match.
Here's where it get's complicated. I want it to find the first match with a specific font format.
eg.
Row 1 apples in font yellow 0
Row 2 Bananas in font yellow 0
Row 3 Apples in default font 25
Row 4 Bananas in default font 50
the rows are conditionally formatted so in row 2 if the value in column 2 is <=0 then bananas font is in yellow. if it's >0 then the format is default.
So I'm trying to get my .find to find the first match with default font.
I've played around with the find in the macro recorder and it can be done but when i try to apply it into my
sub the .find is nothing

Application.FindFormat.NumberFormat = "General"
Application.FindFormat.Locked = True          
Set rCl = .Find(sFind, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)

Here's the code that I attempted but the rCl is returning as nothing. When i remove the findformat lines & the SearchFormat the rCl returns a match as I expect.
I know that it can be done but I just don't know what I'm doing wrong.
Can anyone help??
Thanks in advance

 

[Yongle]

The macro below works

Test like this...
- add a new worksheet
- in A1, A2 and A3 enter the word happy (in all 3 cells)
- UNLOCK cell A1
- change numberformat to TEXT for A2
- run the macro below - it returns A3 (the only cell that matches all conditions)

Sub FindFirst()
    With Application.FindFormat
        .NumberFormat = "General"
        .Locked = True
    End With     
    MsgBox ActiveSheet.Cells.Find(what:="happy", searchformat:=True).Address(0, 0)
End Sub

Now change things ONE at a time until you establish what is causing the search to return nothing for you

 

[Baziwan]

Hi Yongle,

Thanks for the reply. This has helped. I've discovered what may be the issue. Although my conditional formats are changing the cell colour, when I go to format the cell it still shows the cell format as automatic even though they've been conditionally formatted to a different colour. Any idea how I can get around this?

regards

 

[Yongle]

That is your problem
Conditional format is a mirage
Easiest way is to test for the conditional format condition - ie if cell is red because cell value is greater than 200, then test for cell value greater than 200

 

[Baziwan]

Hi,

Yeah that is a real bummer. Unfortunately the sfind is the product name & that's what's
conditionally formatted. I was hoping to speed up my code by having the sfind go straight
to the first match that met the format.
I've been using .findnext with an if condition. eg if rCl.offset(Rw, 2).value <=("0") then findnext
but that involves a lot of looping that slows the process down as there are some products that have
over 100 rows that match but have no value.
Is there a way to have a condition in the .find that it goes strait to the first match where the offset is <=0

regards

 

[Yongle]

I will post amended code when back at my PC in a few hours.

 

[Baziwan]

Thanks for the help Yongle. Much appreciated

 

[Fluff]

How about something like

Sub test2()
   Dim Fnd As Range
   Dim i As Long, Qty As Long
   
   Qty = Application.CountIf(Range("I:I"), "St Albans")
   Set Fnd = Range("I1")
   For i = 1 To Qty
      Set Fnd = Range("I:I").find("St Albans", Fnd, , xlWhole, , , False, , False)
      If Fnd.DisplayFormat.Font.Color = vbYellow Then
         Fnd.Select
         Exit For
      End If
   Next i
End Sub

 

[Rick Rothstein]

How about something like

Sub test2()
   Dim Fnd As Range
   Dim i As Long, Qty As Long
   
   Qty = Application.CountIf(Range("I:I"), "St Albans")
   Set Fnd = Range("I1")
   For i = 1 To Qty
      Set Fnd = Range("I:I").find("St Albans", Fnd, , xlWhole, , , False, , False)
      If Fnd.DisplayFormat.Font.Color = vbYellow Then
         Fnd.Select
         Exit For
      End If
   Next i
End Sub

If a yellow-font St. Albans is in cell I1 and if there are more than one yellow-font St. Albans in the column, your code will ignore the one in cell I1 and find the second one in the column. To correct that, you need to specify the After argument and set it to the last cell in the column.

 

[Yongle]

Mirror conditional formatting in VBA
Loop through an array of values and
- use Range.Find and Range.FindNext to find a match for each value and test against other criteria until the first complete match is found
- test within the loop to identify the first from all the matches found

A simple non-real example
NB - there is a simpler way to find this particular match but this serves to illustrate my method
The VBA below
- looks for the first match of any of 3 specific customers with sales > 99 and Type = "AB"
- and correctly returns address B9 (cust2)

The conditional formatting formula in column B is
=AND(C1>99,D1="AB",OR(B1="cust1",B1="cust2",B1="cust3"))

Date	Customer	Sales	Type
17/10/2018	cust30	100	AB
17/10/2018	cust31	109	AB
18/10/2018	cust32	144	AB
18/10/2018	cust15	118	AB
18/10/2018	cust1	120	CD
18/10/2018	cust2	101	CD
18/10/2018	cust3	146	CD
18/10/2018	cust2	120	AB
18/10/2018	cust3	91	AB
19/10/2018	cust4	61	AB
19/10/2018	cust1	105	AB
19/10/2018	cust6	108	AB
19/10/2018	cust7	135	AB
19/10/2018	cust8	100	AB
20/10/2018	cust3	100	AB
21/10/2018	cust4	94	AB
21/10/2018	cust3	125	AB

<tbody>
</tbody>

Option Explicit
Sub FindCond()

Dim first As Range, cel As Range, rng As Range, addr As String, cust As Variant, msg As String
Set rng = ActiveSheet.Range("B2:B100")
Set first = ActiveSheet.Cells(Rows.Count, 1)
On Error Resume Next
With rng
    For Each cust In Array("cust1", "cust2", "cust3")
        Set cel = .Find(cust, lookat:=xlWhole)
        If Not cel Is Nothing Then
            addr = cel.Address
            If PassTest(cel, first) Then
                Set first = cel
            Else
                Do
                    Set cel = .FindNext(cel)
                    If PassTest(cel, first) And cel.Address <> addr Then
                         Set first = cel: Set cel = Nothing: addr = cel.Address
                    End If
                Loop While Not cel Is Nothing And cel.Address <> addr
            End If
        End If
        Set cel = Nothing: addr = ""
    Next cust
End With

If first.Row < Rows.Count Then msg = first.Address(0, 0) Else msg = "no matches"
MsgBox msg

End Sub

Private Function PassTest(cel As Range, first As Range) As Boolean
    If cel.Offset(, 1) > 99 And cel.Offset(, 2) = "AB" And cel.Row < first.Row Then
        PassTest = True
    Else
        PassTest = False
    End If
End Function