Hi I'm looking to create a macro that will look at one columns and if number in the rows match, look at an amount column and see if the values total to zero, if so, then remove the rows from the sheet and paste in another sheet. I've attached a sample of the data. Basically the macro would look at column E (External Document No.) if the value in the rows is the same, then look at column K (Amount) for those rows. If the amounts for those rows total to zero, then cut and paste those rows into another sheet, leaving items that have yet to match. This is for a reconciliation I'm trying to put together. Please help as it is tedious to go through all of these rows and rows of data. Thanks.
Example:
IS1002711 is in rows 2-4, amounts in each row if added together would be zero, since that is the case all three rows will be cut and pasted into another sheet, removing them from this sheet.
According to the attachment as a VBA beginner starter to paste to the Sheet1 worksheet module :
PHP Code:
Sub Demo1() Const F = "IF({1},ROUND(SUMIF(E2:E#,E2:E#,K2:K#),2)=0)" Application.ScreenUpdating = False With Me.UsedRange.Columns("A:P") .Range("P2:P" & .Rows.Count) = Evaluate(Replace(F, "#", .Rows.Count)) If IsNumeric(Application.Match(True, .Item(16), 0)) Then If Worksheets.Count = 1 Then Sheets.Add , Me Else Sheets(2).UsedRange.Clear .Range("A1:O1").Copy Sheets(2).[A1] .Sort .Item(16), xlAscending, Header:=xlYes .Range("A" & Application.Match(True, .Item(16), 0) & ":O" & .Rows.Count).Cut Sheets(2).[A2] Sheets(2).UsedRange.Columns.AutoFit End If .Item(16).Clear End With Application.ScreenUpdating = True End Sub
► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄
Re: Macro to remove similar lines in another sheet
Awesome Kaper, this does work perfectly. The data will not always be sorted so I removed the ' you had as a comment in the macro so the line is now added. I do like the space as it shows like items together so I may keep it. Thank you so much, this works perfectly! It is going to save me so much time when reconciling! Thanks again.
Re: Macro to remove similar lines in another sheet
Hi Kaper, only issue I'm having is that it can be run only once over the data. Is there a way to append to the data in Sheet2? I see the paste function adds to Cells (1, 1), is there a way to add to the next blank cell in column instead of Cell A1? If I add new data to Sheet1, I would like to rerun the macro. Thanks!
Marc L, this works awesome also. I like that it wipes out the data that is in sheet2 and puts the new reconciled items there. Is there a way to make it append to the items in sheet2 instead?
Re: Macro to remove similar lines in another sheet
Originally Posted by Marc L
Did you see at least the difference between posts #2 & 3 codes with your initial attachment ?
Yes, they are both doing the same thing and leaving the same results, only difference I see is that the second code doesn't arrange the results on sheet two grouped. I feel the first code is cleaner in the sense it groups the results so I know exactly what cleared. Otherwise, the results in sheet1 is really what I'm looking for, so both provide the same results. If Sheet2 can append results it would be better. Thanks for your help.
Re: Macro to remove similar lines in another sheet
As for main question addressed to me, see code after some cleaning (done on smartphone so not tested, but as it was just removing some lines, shall work easily):
Re: Macro to remove similar lines in another sheet
Originally Posted by Kaper
As for main question addressed to me, see code after some cleaning (done on smartphone so not tested, but as it was just removing some lines, shall work easily):
Re: Macro to remove similar lines in another sheet
Originally Posted by Marc L
Very not according to your initial attachment : with post #2 code many rows to be moved to Sheet2 remain in Sheet1 …
I ran the first macro on more data Marc L, seems like you are right, with more data it does not work, it groups the items together and even moves non zero items to the Sheet2, your's does not. Thanks for pointing that out. I'll use yours! I did like the grouping of items though.
Keeping the same kid logic helper column my demonstration revamped for 'grouping items' :
PHP Code:
Sub Demo1r() With Me.UsedRange.Rows C = Application.Match("External Document No.", .Item(1), 0) H = Application.Match("Amount", .Item(1), 0) If IsError(C) Or IsError(H) Then Beep: Exit Sub With .Item("2:" & .Count).Columns V = Evaluate(Replace("IF({1},ROUND(SUMIF(#,#,", "#", .Item(C).Address) & .Item(H).Address & "),2)=0)") If IsError(Application.Match(True, V, 0)) Then Beep: Exit Sub H = .Count + 1 Application.ScreenUpdating = False .Item(H) = V End With If Worksheets.Count = 1 Then Sheets.Add , Me With ActiveWindow: .SplitColumn = 0: .SplitRow = 1: .FreezePanes = True: End With Else Sheets(2).UsedRange.Clear End If .Item(1).Copy Sheets(2).[A1] .Resize(, H).Sort .Columns(H), xlAscending, Header:=xlYes With .Item(Application.Match(True, .Columns(H), 0) & ":" & .Count) .Sort .Cells(C), xlDescending, Header:=xlNo V = .Count Do F = Application.Match(.Cells(V, C), .Columns(C), 0) .Item(F & ":" & V).Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp)(3) V = F - 1 Loop While V .Clear End With .Columns(H).Clear End With Sheets(2).UsedRange.Columns.AutoFit Application.ScreenUpdating = True End Sub
► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄
Last edited by Marc L; 06-24-2020 at 11:23 PM.
Reason: optimization …
Keeping the same kid logic helper column my demonstration revamped for 'grouping items' :
PHP Code:
Sub Demo1r() With Me.UsedRange.Rows C = Application.Match("External Document No.", .Item(1), 0) H = Application.Match("Amount", .Item(1), 0) If IsError(C) Or IsError(H) Then Beep: Exit Sub With .Item("2:" & .Count).Columns V = Evaluate(Replace("IF({1},ROUND(SUMIF(#,#,", "#", .Item(C).Address) & .Item(H).Address & "),2)=0)") If IsError(Application.Match(True, V, 0)) Then Beep: Exit Sub H = .Count + 1 Application.ScreenUpdating = False .Item(H) = V End With If Worksheets.Count = 1 Then Sheets.Add , Me With ActiveWindow: .SplitColumn = 0: .SplitRow = 1: .FreezePanes = True: End With Else Sheets(2).UsedRange.Clear End If .Item(1).Copy Sheets(2).[A1] .Resize(, H).Sort .Columns(H), xlAscending, Header:=xlYes With .Item(Application.Match(True, .Columns(H), 0) & ":" & .Count) .Sort .Cells(C), xlDescending, Header:=xlNo V = .Count Do F = Application.Match(.Cells(V, C), .Columns(C), 0) .Item(F & ":" & V).Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp)(3) V = F - 1 Loop While V .Clear End With .Columns(H).Clear End With Sheets(2).UsedRange.Columns.AutoFit Application.ScreenUpdating = True End Sub
► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄
Originally Posted by Marc L
Thanks for the rep' !
According to grouping items with Kaper's code, you just need to sort the column E before …
Okay, I'll add that to the macro, sort Column "External Document No." prior to macro start and then sort by Column "Posting Date" when macro is finished. Not a bad idea. Thanks for the help. After I was working with a larger set of data though, I realized that External Document No. column had some numbers after the first nine characters. It seems that they were part of the original number, for example it would have the following:
IS1008278
IS1008278 3
IS1008278 4
When the 3 and 4 Document No lines come into play, it does zero out. Anyway to make it sum by the first nine characters rather than an exact match?
Re: Macro to remove similar lines in another sheet
Maybe something weird with the data, I will check it out later …
But before to waste maybe my time I need a clear answer to the post #16 question :
a blank line between 'groups' is it really necessary ? As that's slower than to cut all the block at once …
According to your post #18 attachment a faster way playing with an array
to paste in a regular module (easier for debugging if necessary) and
if you need a blank row between each group just set the constant D to 3 :
PHP Code:
Sub Demo2() Const D = 2 Dim C(1), V, F&, T@, R& With Sheet1.[A1].CurrentRegion.Rows C(0) = Application.Match("Inbound Shipment No", .Item(1), 0) C(1) = Application.Match("Amount", .Item(1), 0) If Application.Count(C) <= UBound(C) Then Beep: Exit Sub Application.ScreenUpdating = False .Item(1).Copy Sheet2.[A1] .Sort .Cells(C(0)), xlAscending, Header:=xlYes V = Application.Index(.Value2, Evaluate("ROW(1:" & .Count & ")"), C) F = 2: T = V(2, 2) For R = 3 To .Count If V(R, 1) = V(F, 1) Then T = T + V(R, 2) Else If T = 0 Then .Item(F & ":" & R - 1).Cut Sheet2.Cells(Rows.Count, 1).End(xlUp)(D) F = R: T = V(R, 2) End If Next If T = 0 Then .Item(F & ":" & R - 1).Cut Sheet2.Cells(Rows.Count, 1).End(xlUp)(D) .Sort .Cells(2), xlAscending, Header:=xlYes .Item(.Cells(1).End(xlDown)(2).Row & ":" & .Count).EntireRow.Delete End With Sheet2.UsedRange.Columns.AutoFit Application.ScreenUpdating = True End Sub
► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄
Last edited by Marc L; 06-25-2020 at 11:23 PM.
Reason: optimization …
Re: Macro to remove similar lines in another sheet
If a blank row between each group is not necessary a faster way than my previous demonstration #2
- ~ 2 seconds less on my side with post #18 attachment -
is still the kid way logic like in my first demonstration but this time just tweaking it to avoid duplicate SUMIF calculations …
Re: Macro to remove similar lines in another sheet
According to post #18 attachment without any blank row in Sheet2 the fastest way - all job done in 1.3s on an old slow laptop ! - is to revamp
my demonstration #2 playing with one more array for the helper column in order to copy and delete rows at once …
Bookmarks