Do Until IsEmpty Looping Issue

[Marmaduke_88]

Excel 2003. I believe I've got everything working in the code up until:

If rnGx = rnGy Then

It loops once and then "Run-time error '424': Object Required" for the code above.

Sub test1()
    Dim rnGx As Range
    Dim rnGy As Range
    Dim i As Long
    Dim xNum As Integer
    Dim yNum As Integer
    i = 2
    Set rnGx = Cells(i, 2)
    Set rnGy = rnGx.Offset(1, 0)
    xNum = rnGx.Offset(0, 2)
    yNum = rnGy.Offset(0, 2)
    With Sheet1
        Do Until IsEmpty(ActiveCell)
            If rnGx = rnGy Then
                rnGx.Offset(0, 2) = (xNum + yNum)
                rnGy.EntireRow.Delete
                i = (i + 1)
                Else
                i = (i + 1)
            End If
        Loop
    End With
End Sub

In case I'm way off, I'm trying to get the code to do the following:

• look for identical entries in column b
• where duplicates exist, sum the corresponding column d values into one of the existing columns
• delete the remaining duplicate
• do this until there are no matches

Column b is sorted ascending, so any matches should be next to each other. as I'm writing this, though - I realize that if there are triplicates or more in column B, this would need to be run more than once. Any suggestions?

 

[Dannyh1]

maybe try:


If rnGx.value = rnGy.value Then</pre>

 

[cstimart]

Are you looking for something like this?

Sub test2()
Dim LR As Long
Dim rng As Range
LR = Cells(Rows.Count, 2).End(xlUp).Offset(-1).Row
    For Each rng In [B2].Resize(LR)
        If rng = rng.Offset(-1) Then
            rng.Offset(, 2) = rng.Offset(, 2) + rng.Offset(-1, 2)
            rng.Value = vbNullString
        End If
    Next rng
Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Your code will run forever, as no values change within the "Loop".

 

[Norie]

You could be deleting rnGy on the first iteration.

So on the 2nd it doesn't exist.

 

[Domski]

Try:

Dim lngLoopRow

For lngLoopRow = Range("B" & Rows.Count).End(xlUp).Row To 3 Step -1
    If Range("B" & lngLoopRow) = Range("B" & lngLoopRow - 1) Then 
        Range("D" & lngLoopRow - 1) = Range("D" & lngLoopRow - 1) + Range("D" & lngLoopRow)
        Rows(lngLoopRow).Delete
    End If
Next lngLoopRow

Dom

 

[Marmaduke_88]

thanks for the quick replies. danny I tried adding .value but it doesn't accept it (I'm thinking because they're ranges?).

cstimart, doesn't i = i+1 change the value in my loop? also, the code you provided doesn't seem to sum column d as it should.

 

[Marmaduke_88]

perfect domski, thanks!

 

[cstimart]

thanks for the quick replies. danny I tried adding .value but it doesn't accept it (I'm thinking because they're ranges?).

cstimart, doesn't i = i+1 change the value in my loop? also, the code you provided doesn't seem to sum column d as it should.

The i = i + 1 is only increasing the value of i. You're not using the 'i' to change the cell(s) being a compared within the Do/Loop.

There was a glitch in my code....which is now fixed

Sub test2()
Dim LR As Long
Dim rng As Range
LR = Cells(Rows.Count, 2).End(xlUp).Offset(-1).Row
    For Each rng In [B2].Resize(LR)
        If rng = rng.Offset(-1) Then
            rng.Offset(, 2) = rng.Offset(, 2) + rng.Offset(-1, 2)
            rng.Offset(-1) = vbNullString
        End If
    Next rng
Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub