VBA - searching values in the same groups

[omersinem]

Hello,
I wanted to find the value I want among the one thousand data in Excel Sheet and I used binary search algorithm it doesn't work for me. Then, I got some errors so I simply rearrange the problem to be understandable more. I would be grateful if you could write the code for the following problem;

1. Check if there is a group (that includes same numbers) at first column
2. If there is a group, select the cell including a value greater than zero at its third column at that group.
3. Write “correct” on the cell in selected row of fourth column

I hope this was clear enough. If there is anything that you don't understand please let me know.
Thanks in advance for your help!

 

[mumps]

Using the data in your picture, the only cell that would contain "correct" would be cell D9. Is this correct? If not, please clarify in detail.

 

[omersinem]

Using the data in your picture, the only cell that would contain "correct" would be cell D9. Is this correct? If not, please clarify in detail.

Yes.

 

[mumps]

Try:

Sub SearchValues()
    Application.ScreenUpdating = False
    Dim v As Variant, dic As Object, i As Long, rng As Range
    v = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If Not dic.exists(v(i, 1)) Then
            dic.Add v(i, 1), Nothing
            With ActiveSheet
                .Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
                If [subtotal(103,A:A)] - 1 > 1 Then
                    For Each rng In Range("C2", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
                        If Split(rng, " ")(0) > 0 Then
                            rng.Offset(, 1) = "correct"
                        End If
                    Next rng
                End If
            End With
        End If
    Next i
    Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub

 

[omersinem]

Denemek:
[KOD=vba]
Alt Arama Değerleri()
Application.ScreenUpdating = Yanlış
Dim v As Variant, dic As Object, i As Long, rng As Range
v = Aralık("A2", Aralık("A" & Rows.Count).End(xlUp)).Resize(, 3).Value
Set dic = CreateObject("Scripting.Dictionary")
i = LBound(v) için UBound(v) için
Eğer dic.varsa(v(i, 1)) O zaman
dic.Add v(i, 1), Hiçbir şey
ActiveSheet ile
.Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
Eğer [ara toplam(103,A:A)] - 1 > 1 ise
Her rng In Range("C2", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
Eğer Split(rng, " ")(0) > 0 ise
rng.Offset(, 1) = "doğru"
Bitir
sonraki zil
Bitir
İle bitmek
Bitir
sonraki ben
Aralık("A1").Otomatik Filtre
Application.ScreenUpdating = Doğru
Alt Bitiş
[/KOD]

It works :büyük sırıtış:. Thank you for your help.

 

[mumps]

You are very welcome.