CODEWITHSUNDEEP
excelfindconditional-statementsvba
lowak
lowak

Reputation: 1284

Excel vba count search results

Few days ago I asked question relating to the same workbook, it's here: Excel countif vba code with criteria resulting with values

So... I got the code below. Basically it searches for a value in a given range and checking for certain value in another cell - then "counts". At least it should counts but it's just input 1 into cell.

It works good, however there is a possibility of having more than one search result in given range. I tried using .findnext but it didn't work as I wanted. I also tried adding another .find and still it was failure.

How to cope with that?

Sub Wstaw_Szkolenia()

Dim MyRange As Range, MyCell As Variant

Range("A1").Select

liczba = 6

Set MyRange = Range(Selection, Selection.End(xlDown)).Rows.SpecialCells(xlCellTypeVisible)

'PP 2dni 2007
For Each MyCell In MyRange.Cells
    With Range("pp2dni2007")
         If .Cells.Find(MyCell.Value) Is Nothing Then

        Else
            If .Cells.Find(MyCell.Value).Offset(0, 3).Value = "TAK" Then
            MyCell.Offset(0, liczba).Value = 1

            Else
            MyCell.Offset(0, liczba).Value = 0

            End If

        End If

    End With
Next

(...)same code, different range(...)

End Sub


Modified code, I don't see any missing with tags.

Sub Wstaw_Szkolenia()

Dim MyRange As Range
Dim rng1 As Range
Dim MyCell As Variant
Dim strAddress As String

liczba = 6

Set MyRange = Range([a1], [a1].End(xlDown)).Rows.SpecialCells(xlCellTypeVisible)

'PP 2dni 2007
For Each MyCell In MyRange.Cells
    With Range("pp2dni2007")
    Set rng1 = .Cells.Find(MyCell.Value)
        If Not rng1 Is Nothing Then

        strAddress = rng1.Address
        Do

            If .Cells.Find(MyCell.Value).Offset(0, 3).Value = "TAK" Then
            MyCell.Offset(0, liczba).Value = MyCell.Offset(0, liczba).Value + 1

            Else
            MyCell.Offset(0, liczba).Value = 0

            End If

        Set rng1 = .Cells.FindNext(rng1)
        Loop While rng1.Address <> strAddress

        End If

    End With

Next


'PP 3dni 2008
For Each MyCell In MyRange.Cells
    With Range("pp3dni2008")
    Set rng1 = .Cells.Find(MyCell.Value)
        If Not rng1 Is Nothing Then

        strAddress = rng1.Address
        Do

            If .Cells.Find(MyCell.Value).Offset(0, 3).Value = "TAK" Then
            MyCell.Offset(0, liczba + 1).Value = MyCell.Offset(0, liczba + 1).Value + 1

            Else
            MyCell.Offset(0, liczba + 1).Value = 0

            End If

        Set rng1 = .Cells.FindNext(rng1)
        Loop While rng1.Address <> strAddress

    End With
Next

(...and repeats for different ranges...)

End Sub

Upvotes: 1

Views: 4398

Answers (1)

brettdj
brettdj

Reputation: 55682

Something like this

Sub Kransky()

Dim MyRange As Range
Dim rng1 As Range
Dim MyCell As Variant
Dim strAddress As String

liczba = 6
Set MyRange = Range([a1], [a1].End(xlDown)).Rows.SpecialCells(xlCellTypeVisible)


For Each MyCell In MyRange.Cells
    With Range("pp2dni2007")
   Set rng1 = .Cells.Find(MyCell.Value)
   If Not rng1 Is Nothing Then
   strAddress = rng1.Address
   Do
            If .Cells.Find(MyCell.Value).Offset(0, 3).Value = "TAK" Then
            MyCell.Offset(0, liczba).Value = MyCell.Offset(0, liczba).Value + 1
            Else
            MyCell.Offset(0, liczba).Value = 0
            End If
    Set rng1 = .Cells.FindNext(rng1)
    Loop While rng1.Address <> strAddress
    End If
    End With
Next

End Sub

Upvotes: 2

Related Questions