Previous Topic Next Topic

Macro Insert Headers after sorting

Closed
geekboy101 Posts 3 Registration date Monday June 24, 2013 Status Member Last seen June 27, 2013 - Jun 24, 2013 at 03:26 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Jun 28, 2013 at 08:34 AM
Hi All,

I have a spreadsheet that would contain a hundreds of thousands of invoices. But to simplify, I am more concerned about the following:

Here is how the file would somehow look like: 

A                B                      C                         D
Invoice #	Due Date	  Days Overdue	 Amount 
CM3	        6/20/2013	4	              (1,000.00)
Inv4	        6/24/2013	0	               1,000.00 
Inv7	        6/27/2013	-3	               1,000.00 
Inv11	  7/1/2013	-7	               1,000.00 
Inv10	6/30/2013	-6	               1,000.00 
inv2	        6/22/2013	2	               1,000.00 
Inv3	        6/23/2013	1	               1,000.00 
Inv9	        6/29/2013	-5	               1,000.00 
CM2	        5/20/2013	34	              (1,000.00)
Inv8	        6/28/2013	-4	               1,000.00 
Inv5	        6/25/2013	-1	               1,000.00 
CM1	        4/20/2013	64	              (1,000.00)
Inv6	        6/26/2013	-2	               1,000.00 
Inv1	        6/21/2013	3	               1,000.00


To simplify matter, what I am trying to achieve is the following.

1.) Sort via amount, and then insert a row and a header, between the positive values and negative values. This will then produce 2 different tables. Then sort the resulting 2nd table, via the oldest to newest.

2.) The resulting 1st table, will then have to be sorted under days overdue. ANd then do the same drill, insert a header, in between the positive and negative value.

3.) each resulting table then had to be labeled accordingly.

This is how, the file would hopefully look like: 

A                 B                   C             D
Past Due:			
Invoice #	Due Date	Days Overdue	 Amount 
Inv1 	6/21/2013	3	 1,000.00 
inv2	        6/22/2013	2	 1,000.00 
Inv3  	6/23/2013	1	 1,000.00 
Inv4 	6/24/2013	0	 1,000.00 
		                  TOTAL:	 4,000.00 
			
Current:			
Invoice #	Due Date	Days Overdue	 Amount 
Inv5 	6/25/2013	-1	 1,000.00 
Inv6 	6/26/2013	-2	 1,000.00 
Inv7  	6/27/2013	-3	 1,000.00 
Inv8 	6/28/2013	-4	 1,000.00 
Inv9 	6/29/2013	-5	 1,000.00 
Inv10	6/30/2013	-6	 1,000.00 
Inv11	  7/1/2013	-7	 1,000.00 
		                    TOTAL:	 7,000.00 
			
Open Credits			
Invoice #	Due Date	Days Overdue	 Amount 
CM1	        4/20/2013	64	 (1,000.00)
CM2  	5/20/2013	34	 (1,000.00)
CM3  	6/20/2013	4	 (1,000.00)
		                    TOTAL:	 (3,000.00)



I understand that I may be being a bit lazy trying to avoid doing these manually, but we're talking about hundreds of thousands of transactions which means I have to do this repeatedly for different customers.

Thanks in advance for the help.

3 responses

Answer 1 / 3
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jun 25, 2013 at 02:41 AM
copy the data in SHEET2 FROM a!

run this macro . the result is in SHEET1 

Sub test()
    Dim r As Range, c As Range, rd As Range
    'undoing
    Worksheets("sheet1").Cells.Clear
    Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("A1")
    'start exercise
    Worksheets("sheet1").Activate
    Set r = Range("A1").CurrentRegion
    r.Sort key1:=Range("D1"), order1:=xlDescending, Header:=xlYes
    Set rd = Range(Range("D2"), Range("D2").End(xlDown))
    For Each c In rd
        'MsgBox c.Row

        If c < 0 Then
            Range(c, c.Offset(1, 0)).EntireRow.Insert
            Range(Range("A1"), Range("A1").End(xlToRight)).Copy Cells(c.Row - 1, "A")

            GoTo outofit
        End If
    Next c
outofit:

    Set r = Range("a1").CurrentRegion
    ' MsgBox r.Address
    r.Sort key1:=Range("B1"), Header:=xlYes
    Set r = Range("a1").End(xlDown).Offset(2, 0)
    Set rd = r.CurrentRegion
    ' MsgBox rd.Address

    rd.Sort key1:=Columns(2), order1:=xlAscending, Header:=xlYes
MsgBox "macro over"

End Sub
0
geekboy101 Posts 3 Registration date Monday June 24, 2013 Status Member Last seen June 27, 2013
Jun 25, 2013 at 05:01 PM
Thanks for your help.
It works well, but is not quite what is needed. The result should be 3 tables.
- the first table should show only invoices (positive amounts) that is more than 0, under days overdue. (Sorted by oldest to newest).
- the second table should contain invoices (positive amounts) that is less than 0 in the days overdue column
- the 3rd table, which you're code is already able to do, contains credits or items with negative balue under amount, regardless of days overdue.

It works well that it separates the positive amounts from the negative amounts under the "Amounts" column, and inserts a header in between. Your code results in 2 tables, the 1st one containing all positive items or invoices, the 2nd table, containing credits or lines with negative value under amount. This works great, but if we can take it a step further and sort the 1st table created from your code, and sort it with largest to smallest under days overdue, find the first value less than zero under that same column and insert the headers there.
0
Answer 2 / 3
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jun 25, 2013 at 10:45 PM
see the result of my macro - you canfind here. comment o this

http://speedy.sh/AjXWh/geek.xlsm
0
geekboy101 Posts 3 Registration date Monday June 24, 2013 Status Member Last seen June 27, 2013
Jun 27, 2013 at 02:15 PM
I downloaded the file and it worked like i described.

It separates the list between positive and negative values under the amount column. But what it fails to do is separate the resulting list between positive and negative values under the days overdue column.

While this is great and I will be able to use this manually, since it splits the credits (amount column).
I still need to manually insert a row between the overdue invoices and current ones. (days overdue column)
0
Answer 3 / 3
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 811
Jun 28, 2013 at 08:34 AM
added a macro testtwo and incorporated in test. enough to run onl;y TEST. 

Sub test()
    'undoing
    Worksheets("sheet1").Cells.Clear
    Worksheets("sheet2").Cells.Copy Worksheets("sheet1").Range("A1")
    'start exercise
    Worksheets("sheet1").Activate
    Set r = Range("A1").CurrentRegion
    r.Sort key1:=Range("D1"), order1:=xlDescending, Header:=xlYes
    Set rd = Range(Range("D2"), Range("D2").End(xlDown))
    For Each c In rd
        'MsgBox c.Row

        If c < 0 Then
            Range(c, c.Offset(1, 0)).EntireRow.Insert
            Range(Range("A1"), Range("A1").End(xlToRight)).Copy Cells(c.Row - 1, "A")

            GoTo outofit
        End If
    Next c
outofit:

    Set r = Range("a1").CurrentRegion
    ' MsgBox r.Address
    r.Sort key1:=Range("B1"), Header:=xlYes
    Set r = Range("a1").End(xlDown).Offset(2, 0)
    Set rd = r.CurrentRegion
    ' MsgBox rd.Address

    rd.Sort key1:=Columns(2), order1:=xlAscending, Header:=xlYes
testtwo


MsgBox "macro over"

End Sub





Sub testtwo()
Dim llastcell As Range

Set r = Range("A1").CurrentRegion

r.Sort key1:=Range("c1"), order1:=xlAscending, Header:=xlYes
Set r = Range(Range("c2"), Range("c2").End(xlDown))
For Each c In r
If c >= 0 Then

Range(c, c.Offset(1, 0)).EntireRow.Insert
GoTo nnext
End If
Next c
nnext:
Range(Range("a1"), Range("a1").End(xlToRight)).Copy Range("a1").End(xlDown).Offset(2, 0)


End Sub
0

Similar discussions

Nfs most wanted 2005 shows "please insert the correct CD
Prabal -
ac3mark -

1 response
Micro sd card showing "please insert Disk"
Joreece -
meme -

6 responses