I have posted on this website once before about a problem I am having trying
to create a macro that will delete accounts with credits and debits of the
same amount. I never could get the macros to work that I was given to try,
so since this has been a while ago, thought I'd try again. Going to try to
make it as simple as I can. I have a report in Excel, contains the following
information:
A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/AMT

In these columns is patient information that is updated daily, and changes
daily. It is showing patients that are charged room charges, and sometimes
the room charges are wrong, so are credited back to that patient account, and
sometimes the correct one is added on. I have been manually going in and
deleting the credits and debits, and need to find a way to do this with a
macro. Below is shown an example of data in the report, and which ones would
be deleted. Sorry if this is a little long, but need to show different
scenarios. The asterisks to the side show which rows would be deleted. I
sort by PatientNo, CNSDay and AMT, if there is a debit and credit for the
same patient, same CNSDay and same amount, it gets deleted. Hope this makes
sense, I need help badly, this is taking so much time to do it manually every
day since this report can contain as many as 1000 or more patient listings at
a time. Thanks in advance for your assistance!!!

A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/ AMT
1502 2000000 John Doe 1 15 M MIP 1
1,044.74
1502 2000000 John Doe 2 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 2 15 M MIP 1
1,023.75
1502 2000000 John Doe 2 15 M MIP 1
1,044.74 *
1502 2000000 John Doe 3 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 3 15 M MIP 1
1,023.75
1502 2000000 John Doe 3 15 M MIP 1
1,044.74 *
1621 2000001 Joe Schmoe 9 13 N SWG (1)
(1,023.75) *
1621 2000001 Joe Schmoe 9 13 N SWG 1 457.07
1621 2000001 Joe Schmoe 9 13 N MIP 1
1,023.75 *
1751 2000002 Sandy Box 7 7 MG SWG (1)
(1,371.22) *
1751 2000002 Sandy Box 7 7 MG ICU 1
1,371.22 *
1760 2000003 Anne Ride 1 4 H MIP 1
1,023.75
1760 2000003 Anne Ride 2 4 H MIP 1
1,023.75
1071 2000004 Ed Crumply 7 1 F SIP (1)
(708.93) *
1071 2000004 Ed Crumply 7 1 F SIP 1
708.93 *

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
'

'
Lastrow = Range("A" & 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("A" & 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:

I have posted on this website once before about a problem I am having trying
to create a macro that will delete accounts with credits and debits of the
same amount. I never could get the macros to work that I was given to try,
so since this has been a while ago, thought I'd try again. Going to try to
make it as simple as I can. I have a report in Excel, contains the following
information:
A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/AMT

In these columns is patient information that is updated daily, and changes
daily. It is showing patients that are charged room charges, and sometimes
the room charges are wrong, so are credited back to that patient account, and
sometimes the correct one is added on. I have been manually going in and
deleting the credits and debits, and need to find a way to do this with a
macro. Below is shown an example of data in the report, and which ones would
be deleted. Sorry if this is a little long, but need to show different
scenarios. The asterisks to the side show which rows would be deleted. I
sort by PatientNo, CNSDay and AMT, if there is a debit and credit for the
same patient, same CNSDay and same amount, it gets deleted. Hope this makes
sense, I need help badly, this is taking so much time to do it manually every
day since this report can contain as many as 1000 or more patient listings at
a time. Thanks in advance for your assistance!!!

A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/ AMT
1502 2000000 John Doe 1 15 M MIP 1
1,044.74
1502 2000000 John Doe 2 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 2 15 M MIP 1
1,023.75
1502 2000000 John Doe 2 15 M MIP 1
1,044.74 *
1502 2000000 John Doe 3 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 3 15 M MIP 1
1,023.75
1502 2000000 John Doe 3 15 M MIP 1
1,044.74 *
1621 2000001 Joe Schmoe 9 13 N SWG (1)
(1,023.75) *
1621 2000001 Joe Schmoe 9 13 N SWG 1 457.07
1621 2000001 Joe Schmoe 9 13 N MIP 1
1,023.75 *
1751 2000002 Sandy Box 7 7 MG SWG (1)
(1,371.22) *
1751 2000002 Sandy Box 7 7 MG ICU 1
1,371.22 *
1760 2000003 Anne Ride 1 4 H MIP 1
1,023.75
1760 2000003 Anne Ride 2 4 H MIP 1
1,023.75
1071 2000004 Ed Crumply 7 1 F SIP (1)
(708.93) *
1071 2000004 Ed Crumply 7 1 F SIP 1
708.93 *

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
'

'
Lastrow = Range("A" & 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("A" & 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:

I have posted on this website once before about a problem I am having trying
to create a macro that will delete accounts with credits and debits of the
same amount. I never could get the macros to work that I was given to try,
so since this has been a while ago, thought I'd try again. Going to try to
make it as simple as I can. I have a report in Excel, contains the following
information:
A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/AMT

In these columns is patient information that is updated daily, and changes
daily. It is showing patients that are charged room charges, and sometimes
the room charges are wrong, so are credited back to that patient account, and
sometimes the correct one is added on. I have been manually going in and
deleting the credits and debits, and need to find a way to do this with a
macro. Below is shown an example of data in the report, and which ones would
be deleted. Sorry if this is a little long, but need to show different
scenarios. The asterisks to the side show which rows would be deleted. I
sort by PatientNo, CNSDay and AMT, if there is a debit and credit for the
same patient, same CNSDay and same amount, it gets deleted. Hope this makes
sense, I need help badly, this is taking so much time to do it manually every
day since this report can contain as many as 1000 or more patient listings at
a time. Thanks in advance for your assistance!!!

A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/ AMT
1502 2000000 John Doe 1 15 M MIP 1
1,044.74
1502 2000000 John Doe 2 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 2 15 M MIP 1
1,023.75
1502 2000000 John Doe 2 15 M MIP 1
1,044.74 *
1502 2000000 John Doe 3 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 3 15 M MIP 1
1,023.75
1502 2000000 John Doe 3 15 M MIP 1
1,044.74 *
1621 2000001 Joe Schmoe 9 13 N SWG (1)
(1,023.75) *
1621 2000001 Joe Schmoe 9 13 N SWG 1 457.07
1621 2000001 Joe Schmoe 9 13 N MIP 1
1,023.75 *
1751 2000002 Sandy Box 7 7 MG SWG (1)
(1,371.22) *
1751 2000002 Sandy Box 7 7 MG ICU 1
1,371.22 *
1760 2000003 Anne Ride 1 4 H MIP 1
1,023.75
1760 2000003 Anne Ride 2 4 H MIP 1
1,023.75
1071 2000004 Ed Crumply 7 1 F SIP (1)
(708.93) *
1071 2000004 Ed Crumply 7 1 F SIP 1
708.93 *

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
'

'
Lastrow = Range("A" & 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("A" & 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:

I have posted on this website once before about a problem I am having trying
to create a macro that will delete accounts with credits and debits of the
same amount. I never could get the macros to work that I was given to try,
so since this has been a while ago, thought I'd try again. Going to try to
make it as simple as I can. I have a report in Excel, contains the following
information:
A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/AMT

In these columns is patient information that is updated daily, and changes
daily. It is showing patients that are charged room charges, and sometimes
the room charges are wrong, so are credited back to that patient account, and
sometimes the correct one is added on. I have been manually going in and
deleting the credits and debits, and need to find a way to do this with a
macro. Below is shown an example of data in the report, and which ones would
be deleted. Sorry if this is a little long, but need to show different
scenarios. The asterisks to the side show which rows would be deleted. I
sort by PatientNo, CNSDay and AMT, if there is a debit and credit for the
same patient, same CNSDay and same amount, it gets deleted. Hope this makes
sense, I need help badly, this is taking so much time to do it manually every
day since this report can contain as many as 1000 or more patient listings at
a time. Thanks in advance for your assistance!!!

A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/ AMT
1502 2000000 John Doe 1 15 M MIP 1
1,044.74
1502 2000000 John Doe 2 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 2 15 M MIP 1
1,023.75
1502 2000000 John Doe 2 15 M MIP 1
1,044.74 *
1502 2000000 John Doe 3 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 3 15 M MIP 1
1,023.75
1502 2000000 John Doe 3 15 M MIP 1
1,044.74 *
1621 2000001 Joe Schmoe 9 13 N SWG (1)
(1,023.75) *
1621 2000001 Joe Schmoe 9 13 N SWG 1 457.07
1621 2000001 Joe Schmoe 9 13 N MIP 1
1,023.75 *
1751 2000002 Sandy Box 7 7 MG SWG (1)
(1,371.22) *
1751 2000002 Sandy Box 7 7 MG ICU 1
1,371.22 *
1760 2000003 Anne Ride 1 4 H MIP 1
1,023.75
1760 2000003 Anne Ride 2 4 H MIP 1
1,023.75
1071 2000004 Ed Crumply 7 1 F SIP (1)
(708.93) *
1071 2000004 Ed Crumply 7 1 F SIP 1
708.93 *

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
'

'
Lastrow = Range("A" & 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("A" & 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:

I have posted on this website once before about a problem I am having trying
to create a macro that will delete accounts with credits and debits of the
same amount. I never could get the macros to work that I was given to try,
so since this has been a while ago, thought I'd try again. Going to try to
make it as simple as I can. I have a report in Excel, contains the following
information:
A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/AMT

In these columns is patient information that is updated daily, and changes
daily. It is showing patients that are charged room charges, and sometimes
the room charges are wrong, so are credited back to that patient account, and
sometimes the correct one is added on. I have been manually going in and
deleting the credits and debits, and need to find a way to do this with a
macro. Below is shown an example of data in the report, and which ones would
be deleted. Sorry if this is a little long, but need to show different
scenarios. The asterisks to the side show which rows would be deleted. I
sort by PatientNo, CNSDay and AMT, if there is a debit and credit for the
same patient, same CNSDay and same amount, it gets deleted. Hope this makes
sense, I need help badly, this is taking so much time to do it manually every
day since this report can contain as many as 1000 or more patient listings at
a time. Thanks in advance for your assistance!!!

A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/ AMT
1502 2000000 John Doe 1 15 M MIP 1
1,044.74
1502 2000000 John Doe 2 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 2 15 M MIP 1
1,023.75
1502 2000000 John Doe 2 15 M MIP 1
1,044.74 *
1502 2000000 John Doe 3 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 3 15 M MIP 1
1,023.75
1502 2000000 John Doe 3 15 M MIP 1
1,044.74 *
1621 2000001 Joe Schmoe 9 13 N SWG (1)
(1,023.75) *
1621 2000001 Joe Schmoe 9 13 N SWG 1 457.07
1621 2000001 Joe Schmoe 9 13 N MIP 1
1,023.75 *
1751 2000002 Sandy Box 7 7 MG SWG (1)
(1,371.22) *
1751 2000002 Sandy Box 7 7 MG ICU 1
1,371.22 *
1760 2000003 Anne Ride 1 4 H MIP 1
1,023.75
1760 2000003 Anne Ride 2 4 H MIP 1
1,023.75
1071 2000004 Ed Crumply 7 1 F SIP (1)
(708.93) *
1071 2000004 Ed Crumply 7 1 F SIP 1
708.93 *

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
'

'
Lastrow = Range("A" & 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("A" & 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:

I have posted on this website once before about a problem I am having trying
to create a macro that will delete accounts with credits and debits of the
same amount. I never could get the macros to work that I was given to try,
so since this has been a while ago, thought I'd try again. Going to try to
make it as simple as I can. I have a report in Excel, contains the following
information:
A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/AMT

In these columns is patient information that is updated daily, and changes
daily. It is showing patients that are charged room charges, and sometimes
the room charges are wrong, so are credited back to that patient account, and
sometimes the correct one is added on. I have been manually going in and
deleting the credits and debits, and need to find a way to do this with a
macro. Below is shown an example of data in the report, and which ones would
be deleted. Sorry if this is a little long, but need to show different
scenarios. The asterisks to the side show which rows would be deleted. I
sort by PatientNo, CNSDay and AMT, if there is a debit and credit for the
same patient, same CNSDay and same amount, it gets deleted. Hope this makes
sense, I need help badly, this is taking so much time to do it manually every
day since this report can contain as many as 1000 or more patient listings at
a time. Thanks in advance for your assistance!!!

A B C D E F G
H I
Room#/PatientNo/Patient Name/CNSDay/#Days/F_C/HSV/QTY/ AMT
1502 2000000 John Doe 1 15 M MIP 1
1,044.74
1502 2000000 John Doe 2 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 2 15 M MIP 1
1,023.75
1502 2000000 John Doe 2 15 M MIP 1
1,044.74 *
1502 2000000 John Doe 3 15 M MIP (1)
(1,044.74) *
1502 2000000 John Doe 3 15 M MIP 1
1,023.75
1502 2000000 John Doe 3 15 M MIP 1
1,044.74 *
1621 2000001 Joe Schmoe 9 13 N SWG (1)
(1,023.75) *
1621 2000001 Joe Schmoe 9 13 N SWG 1 457.07
1621 2000001 Joe Schmoe 9 13 N MIP 1
1,023.75 *
1751 2000002 Sandy Box 7 7 MG SWG (1)
(1,371.22) *
1751 2000002 Sandy Box 7 7 MG ICU 1
1,371.22 *
1760 2000003 Anne Ride 1 4 H MIP 1
1,023.75
1760 2000003 Anne Ride 2 4 H MIP 1
1,023.75
1071 2000004 Ed Crumply 7 1 F SIP (1)
(708.93) *
1071 2000004 Ed Crumply 7 1 F SIP 1
708.93 *