| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Macro to delete rows with matching Credits and Debits
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 * |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro to delete rows with matching Credits and Debits
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 * |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro to delete rows with matching Credits and Debits
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 * |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro to delete rows with matching Credits and Debits
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 * |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro to delete rows with matching Credits and Debits
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 * |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro to delete rows with matching Credits and Debits
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 * |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro to delete rows with matching Credits and Debits
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 ' ' 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 * |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro to delete rows with matching Credits and Debits
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 ' ' 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) |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Macro to delete rows with matching Credits and Debits
Joel, never mind, and thanks for all the work you did on this! I found the
problem, was my mistake! 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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Delete BOTH sets duplicate data in columns (debits/credits) | Excel Worksheet Functions | |||
| Using Sumif with debits & credits | Excel Discussion (Misc queries) | |||
| vertical lines between credits and debits | New Users to Excel | |||
| debits and credits in one column | Excel Programming | |||
| incrementing rows for matching debits/credits | Excel Programming | |||
Linear Mode
