Conditional Loop (VBA)

[excel_root]

Hi everyone,

I would appreciate if anyone can help me with theis code:

Sub pairs()
Dim sh As Worksheet, tb As Long, c As Range, sVal As Range
    Set sh = Sheets(1) 'Edit sheet name
    tb = sh.Cells(Rows.Count, 1).End(xlUp).Row
        For Each c In sh.Range("B2:B50") 'Assumes header row
            Set sVal = sh.Range("A2:A" & tb).Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
                If sVal Is Nothing Then
                 If sVal.Offset(0, 1).Value = 1 Then GoTo NextIteration
                  ElseIf sVal.Offset(0, 1).Value = "" Then
                    fVal.Offset(0, 1).Value = 1
                    c.Offset(0, 1).Value = 1
                    Else
                End If
NextIteration:
        Next
End Sub

I am trying to find all "pairs" of duplicate values within two colums. In order to do that, I am using flags (i.e. 1 if duplicate had been found before, 0 if not). However, when I am trying to run the macro, returns an error as "Object variable or With block variable not set". I believe have to re-write the code - so there is no reference to sVal as it can be "Nothing"

Any ideas? This is a part of more complex code (described below)


Basically, I am trying to find duplicates in two different columns with different criterias. Example of talbe:

Name1	Colour1	Price1	Name2	Colour2	Price2
Kate	Green	80	Antony	Pink	110
Andrew	Green	75	Lisa	Blue	99
Mark	Yellow	105	Kate	Green	80
Kate	Green	80	Kate	Green	100
Mark	Yellow	90	Mark	Yellow	90
Lisa	Red	99

<tbody>
</tbody>

Programm is suppose to:

Loop for each Name1 value in Name2 range

If Name1.Value is equals to Name2.Value, then check the flags (i.e. if the Name2. value had been found previously)
If flag is equal to 1 or 2, then skip this Name2 cell (as this cell had been previously matched) and continue to loop for next possible duplicate in Name2 range
if flag value is 0 check second condition (Colour)
If Colour1 is equal to Colour2 for the corresponding Names then check third condition (Price)
Else skip this Name1 cell (because it does not match as per Colours criteria) and continue to loop for next Name1.cell value
If Price 1 is equal to Price2 of the corresponding Names then mark the matching rows of the fist and second columns (Name1:Price1) (Name2:Price2) with flag1
Else mark the matching rows of the fist and second columns (Name1:Price1) (Name2:Price2) with flag2

After the loop is completed for all Name1 cells, cut all rows with flag1 and paste to new Sheet2; cut all rows with flag2 and paste to new Sheet2
remove blank rows in the main (Acitve) Sheet

I hope I explained clearly.

Hope you can help me with this

 

[bobsan42]

Re: COnditional Loop (VBA)

I think there is a flaw in your logic - the first IF statement should be IF NOT. When a match is not found sVal WILL be Nothing.

[B][COLOR=#333333]If sVal Is Nothing Then[/COLOR][/B]

Frankly I have some trouble completely understanding and following through the embedded IFs sequence. Do not mix ElseIf
I suggest you clear it up a bit and at least for now keep the same basic structure all along:

IF .... Then
...
Else
....
End if

Another suggestion - ditch the GoTo: replace If sVal.Offset(0, 1).Value = 1 Then GoTo NextIteration with

[/COLOR][B]If sVal.Offset(0, 1).Value <> 1 Then
[/B][COLOR=#333333].......
End if

there is an undefined variable in your code: fVal.Offset(0, 1).Value = 1
I would assume fVal should be sVal but I don't have the full code, so I can't be sure.
Also, I think sVal.Offset(0, 1).Value refers to the value of Column B, while it should refer to the flag value and should probably be c.Offset(0, 1).Value.

Give a go and check which of my remarks are correct.

 

[excel_root]

Re: COnditional Loop (VBA)

Hi bobsan42,

Thank you for valuable comments - I have made corrections as per your recommendations; I also found couple examples and modified the code:

Sub pairs2()
Dim sh As Worksheet, tb As Long, c As Range, sVal As Range
    Set sh = Sheets(1)
    tb = sh.Cells(Rows.Count, 1).End(xlUp).Row
        For Each c In sh.Range("E2:E50") 'Assumes header row
            Set sVal = sh.Range("A2:A" & tb).Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole)
                If Not sVal Is Nothing Then
                    sAdr = sVal.Address
                    Do
                    sVal.Offset(0, 3).Value = 1
                    c.Offset(0, 3).Value = 1
                    sVal.Value = c.Value
                    Set sVal = sh.Range("A2:A" & tb).FindNext(sVal)
                    Loop While sVal.Address <> sAdr
                End If
        Next
End Sub

When I am running this code, I got this result (for this example I have only only criteria for simplicity):

Name1 flag Name2 flagKate 1 Antony
Andrew Lisa 1
Mark 1 Kate 1
Kate 1 Kate 1
Mark 1 Mark 1
Lisa 1


All duplicates are checked with flags; however I am looking to check the cell value in Name1 range as duplicate only if this value has not been found before in the Name1 range. In this example "Mark" has been found before and tagged with flag 1, so I would like to skip the tag for second "Mark" in Name1 range.

I really appreciate your help!