Find and FindNext, issues

[xelasebrof]

I have many lists that i have combined into one big list.

In order to summarize the list on the summary page, I'm trying to use VBA however I'm having problems. Firstly a big thanks to the lovely people on this forum for your help so far.

If not got round to adding a loop for each row in ("Combined") as its have trouble dealing with only 1 row.

For each row in "combined" column B [model] it should search "summary" for [model] entries already there. There should only be two instances of model in "Summary" with different statuses PASS or 3.

If its there already and the status is the same it should add 1 to the qty. If the model and the status cant be found they should be added to the summary.

Feel like im going in circles, so any help appreciated

Sub Find_First()

Dim FindString As String
Dim Rng As Range
Dim status As String
Dim rng2 As Range



FindString = Sheets("Combined").Range("b2").Value
status = Sheets("Combined").Range("b2").Offset(0, 2).Value

If Trim(FindString) <> "" Then
With Sheets("Summary").Range("b:b")
Set Rng = .Find(What:=FindString, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Rng Is Nothing Then

Range("B65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = FindString
ActiveCell.Offset(0, 2).Value = status
ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value + 1


Else

If Not Rng Is Nothing And Rng.Offset(0, 2).Value = status Then


Application.Goto Rng, True

ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value + 1

Else

If Not Rng Is Nothing And Rng.Offset(0, 2).Value <> status Then

Application.Goto Rng, True

With Sheets("Summary").Range("b:b")
Set rng2 = .Find(What:=FindString, _
after:=Rng, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If rng2 Is Nothing Then

Range("B65536").End(xlUp).Offset(1, 0).Select
ActiveCell.Value = FindString
ActiveCell.Offset(0, 2).Value = status
ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value + 1

Else

If Not rng2 Is Nothing And rng2.Offset(0, 2).Value = status Then


Application.Goto rng2, True

ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value + 1
End If


End If




End Sub

[davesexcel]

You can edit your post, to add code tags.


CodeTags.jpg