Macro to delete rows with matching Credits and Debits
Joel,
Sorry it has taken me so long to copy the new code in and try it. I am
getting a Type Mismatch Error now. When I go into Debug, this part is
highlighted:
f Range("B" & RowCount) = Range("B" & MatchRow) And _
Range("D" & RowCount) = Range("D" & MatchRow) And _
Range("I" & RowCount) = -1 * Range("I" & MatchRow) Then
Thanks, for your help!!!
Tasha
"Joel" wrote:
I found a slight problem with the 2nd method that runs faster. If there arre
no duplicates it clears the entire worksheet except for the header row. The
slower code doesn't havve the problem. The code below fixes this problem
Sub DeleteDuplicates1()
'
' Macro1 Macro
' Macro recorded 1/29/2008 by Joel Warburg
'
'
LastRow = Range("B" & Rows.Count).End(xlUp).Row
'add auxilarry column with absolute amount
For RowCount = 2 To LastRow
If Range("I" & RowCount) 0 Then
Range("J" & RowCount) = Range("I" & RowCount)
Else
Range("J" & RowCount) = -1 * Range("I" & RowCount)
End If
Next RowCount
'sort data by Patient - CNSDay - Absolute Amount
Range("A2:J" & LastRow).Sort _
Key1:=Range("B2"), _
MatchCase:=False, _
Key2:=Range("D2"), _
MatchCase:=False, _
Key3:=Range("J2"), _
MatchCase:=False
'delete duplicates
'put true in column K if need to be deleted
RowCount = 2
Do While Range("B" & RowCount) < ""
Match = False
MatchRow = RowCount + 1
Do While Range("B" & RowCount) = Range("B" & MatchRow) And _
Range("D" & RowCount) = Range("D" & MatchRow) And _
Range("J" & RowCount) = Range("J" & MatchRow)
If Range("K" & RowCount) < True And _
Range("K" & MatchRow) < True Then
If Range("B" & RowCount) = Range("B" & MatchRow) And _
Range("D" & RowCount) = Range("D" & MatchRow) And _
Range("I" & RowCount) = -1 * Range("I" & MatchRow) Then
Range("K" & RowCount) = True
Range("K" & MatchRow) = True
Exit Do
End If
End If
MatchRow = MatchRow + 1
Loop
RowCount = RowCount + 1
Loop
'Sort by column K which contains True if item should be deleted.
Range("A2:K" & LastRow).Sort _
Key1:=Range("K2")
If Range("K2") = True Then
LastRow = Range("K2").End(xlDown).Row
Rows("2" & ":" & LastRow).Delete
End If
' If Match = True Then
' Rows(MatchRow).Delete
' Rows(RowCount).Delete
'remove auxillary columns J & K
Columns("J:K").Delete
End Sub
"Tasha" wrote:
That worked like a charm Joel!!! You are brilliant! Thank you sooo soo much!!!!
"Joel" wrote:
The last code was running a little slow. Deleting one row at a time
significantly slows down the code. the new code below marks all the rows
that need to be deleted by putting a true in column K. then it sorts by
column K to get all the trues together. Next it deltes the range of cells
that have True in them. It will run much faster.
Sub DeleteDuplicates1()
'
' Macro1 Macro
' Macro recorded 1/29/2008 by Joel Warburg
'
'
LastRow = Range("B" & Rows.Count).End(xlUp).Row
'add auxilarry column with absolute amount
For RowCount = 2 To LastRow
If Range("I" & RowCount) 0 Then
Range("J" & RowCount) = Range("I" & RowCount)
Else
Range("J" & RowCount) = -1 * Range("I" & RowCount)
End If
Next RowCount
'sort data by Patient - CNSDay - Absolute Amount
Range("A2:J" & LastRow).Sort _
Key1:=Range("B2"), _
MatchCase:=False, _
Key2:=Range("D2"), _
MatchCase:=False, _
Key3:=Range("J2"), _
MatchCase:=False
'delete duplicates
'put true in column K if need to be deleted
RowCount = 2
Do While Range("B" & RowCount) < ""
Match = False
MatchRow = RowCount + 1
Do While Range("B" & RowCount) = Range("B" & MatchRow) And _
Range("D" & RowCount) = Range("D" & MatchRow) And _
Range("J" & RowCount) = Range("J" & MatchRow)
If Range("K" & RowCount) < True And _
Range("K" & MatchRow) < True Then
If Range("B" & RowCount) = Range("B" & MatchRow) And _
Range("D" & RowCount) = Range("D" & MatchRow) And _
Range("I" & RowCount) = -1 * Range("I" & MatchRow) Then
Range("K" & RowCount) = True
Range("K" & MatchRow) = True
Exit Do
End If
End If
MatchRow = MatchRow + 1
Loop
RowCount = RowCount + 1
Loop
'Sort by column K which contains True if item should be deleted.
Range("A2:K" & LastRow).Sort _
Key1:=Range("K2")
LastRow = Range("K2").End(xlDown).Row
Rows("2" & ":" & LastRow).Delete
' If Match = True Then
' Rows(MatchRow).Delete
' Rows(RowCount).Delete
'remove auxillary columns J & K
Columns("J:K").Delete
End Sub
"Joel" wrote:
Most people only want one of a duplicate row deleted. I forgot to remove the
2nd row. also there was a potential problem if there was two charges for the
same amount on the same day. The code wouldn't of worked properly under
this case. If fixed all the problems.
Sub DeleteDuplicates()
'
' Macro1 Macro
' Macro recorded 1/29/2008 by Joel Warburg
'
'
Lastrow = Range("B" & Rows.Count).End(xlUp).Row
'add auxilarry column with absolute amount
For RowCount = 2 To Lastrow
If Range("I" & RowCount) 0 Then
Range("J" & RowCount) = Range("I" & RowCount)
Else
Range("J" & RowCount) = -1 * Range("I" & RowCount)
End If
Next RowCount
'sort data by Patient - CNSDay - Absolute Amount
Range("A2:J" & Lastrow).Sort _
Key1:=Range("B2"), _
MatchCase:=False, _
Key2:=Range("D2"), _
MatchCase:=False, _
Key3:=Range("J2"), _
MatchCase:=False
'delete duplicates
RowCount = 2
Do While Range("B" & RowCount) < ""
Match = False
MatchRow = RowCount + 1
Do While Range("B" & RowCount) = Range("B" & MatchRow) And _
Range("D" & RowCount) = Range("D" & MatchRow) And _
Range("J" & RowCount) = Range("J" & MatchRow)
If Range("B" & RowCount) = Range("B" & MatchRow) And _
Range("D" & RowCount) = Range("D" & MatchRow) And _
Range("I" & RowCount) = -1 * Range("I" & MatchRow) Then
Match = True
Exit Do
End If
MatchRow = MatchRow + 1
Loop
If Match = True Then
Rows(MatchRow).Delete
Rows(RowCount).Delete
Else
RowCount = RowCount + 1
End If
Loop
'remove auxillary column J
Columns("J:J").Delete
End Sub
"Tasha" wrote:
Joel, It seems to be deleting the credits but not the matching debits. I
highlighted the items on a patient that should have been deleted in one
color, and the ones that should have stayed in another, and there were 2
debits left that should have been deleted along with the 2 matching
credits.~~Thank you so much again for helping me with this!!! You have no
idea how much I appreciate it!
"Joel" wrote:
I made two simple changes. Instead of testing for the last row using column
A I'm now using column B.
Sub DeleteDuplicates()
'
' Macro1 Macro
' Macro recorded 1/29/2008 by Joel Warburg
'
'
Lastrow = Range("B" & Rows.Count).End(xlUp).Row
'add auxilarry column with absolute amount
For RowCount = 2 To Lastrow
If Range("I" & RowCount) 0 Then
Range("J" & RowCount) = Range("I" & RowCount)
Else
Range("J" & RowCount) = -1 * Range("I" & RowCount)
End If
Next RowCount
'sort data by Patient - CNSDay - Absolute Amount
Range("A2:J" & Lastrow).Sort _
Key1:=Range("B2"), _
MatchCase:=False, _
Key2:=Range("D2"), _
MatchCase:=False, _
Key3:=Range("J2"), _
MatchCase:=False
'delete duplicates
RowCount = 2
Do While Range("B" & RowCount) < ""
If Range("B" & RowCount) = Range("B" & (RowCount + 1)) And _
Range("D" & RowCount) = Range("D" & (RowCount + 1)) And _
Range("I" & RowCount) = -1 * Range("I" & (RowCount + 1)) Then
Rows(RowCount).Delete
Else
RowCount = RowCount + 1
End If
Loop
'remove auxillary column J
Columns("J:J").Delete
End Sub
"Tasha" wrote:
Thanks so much Joel for your reply. I thought it had worked, as I scrolled
down through my report, until I got halfway down then it stopped working and
the credits/debits are still on the bottom half. It seems to have stopped at
an account that doesn't have a room number, which some of them sometimes
won't because they are observation patients and not actually admitted to a
room. Not sure why it stopped though if you have it sorting by PatNo, CNSDay
and AMT? The room# shouldn't have anything to do with it, should it?
"Joel" wrote:
This code should work. I added a new column J to sort by absolute amount of
AMT. Then I check if the present row and next row match using patient name,
CNSDAY and AMT (column I) = -1 * next row.
Sub DeleteDuplicates()
'
' Macro1 Macro
' Macro recorded 1/29/2008 by Joel Warburg
|