troubleshooting Question

Macro not working on all the way through the document

Avatar of cnl83
cnl83Flag for United States of America asked on
Microsoft ExcelSpreadsheetsVB Script
5 Comments3 Solutions440 ViewsLast Modified:
MacroEE.xlsmAttached is an excel 2010 document with a Macro. The macro is designed to combine multiple rows with the same employee ID and total the points. This worked the last time I used it, but on this particular document it only works up to a certain point. If you hit CTRL T it will run the macro. I can't tell where its stopping or see any inconsistencies that would cause it to not stop.

After the macro runs, we should end up with about 800-1000 records.

<<Code added by byundt--Microsoft Excel Zone Advisor 5-22-12 so question would make sense without sample workbook>>
Sub David_Macro()
'
' David_Macro Macro
' Combine Rows and Total Points
'

'
Dim RowCount As Long
Dim i As Long
Dim j As Long

'Find out how many rows have data
RowCount = ActiveSheet.Range("A:A").End(xlDown).Row

For i = 2 To RowCount
    ' If a row value in col E is the same as the next row then...
    If Range("E" & i).Value = Range("E" & i + 1).Value Then
        ' ...start looking for all rows that follow it that have the same value
        For j = i + 1 To RowCount
            If Range("E" & j).Value = Range("E" & i).Value Then
                ' We've found one that's the same so add the value in column C to the first one
                Range("C" & i).Value = Range("C" & i).Value + Range("C" & j).Value
                ' Mark the row we just used for later deletion
                Range("K" & j).Value = "DELETE"
            Else
                Exit For
            End If
        Next
        i = j - 1
    End If
Next

' Delete the marked rows
For i = RowCount To 2 Step -1
    If Range("K" & i).Value = "DELETE" Then
        Rows(i & ":" & i).Select
        Selection.Delete Shift:=xlUp
    End If
Next
End Sub
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 3 Answers and 5 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 3 Answers and 5 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros