Sum rows by ageing

[Panoos64]

Hi to everyone, i would like to write a VBA command so that to sum the rows which are contains in column "C" the letters "CRN" & "COR". and are over one year as from today which is in column "F"3 and delete then the rows which are sub totals. In addition the name of Debtor in column 'A" should be turn to one row below so that to be in the same line of the sum. At F.1. are the data before adjusting and in F.2. is the expected result. The rows are change when ever i download the data and the spreadsheet contains more than 30.000 rows. I would be greatly appreciated any help. Thanking you in advance.

	A	B	C	D	E	F
1
2
3						10/12/2014
4
5	Debtor Name	Date	Document	Description	Debit	Credit
6
7	Company ABCD
8		13/3/2010	CRN - 13031001	CREDIT NOTE	0,00	1.580,00
9		25/5/2011	CRN- 25051101	CREDIT NOTE	0,00	620,00
10		25/10/2014	COR - 125214	CORRECTION	0,00	155,00
11	Company EFGH
12		25/8/2010	CRN - 25081001	CREDIT NOTE	0,00	150,00
13		13/9/2010	CRN - 13091002	CREDIT NOTE	0,00	75,00
14		10/8/2014	CRN - 10081401	CREDIT NOTE	0,00	225,00
15		15/9/2014	COR - 25090902	CORRECTION	0,00	55,00

<colgroup><col style="mso-width-source:userset;mso-width-alt:2048;width:42pt" width="56"> <col style="mso-width-source:userset;mso-width-alt:3840;width:79pt" width="105"> <col style="mso-width-source:userset;mso-width-alt:3108;width:64pt" width="85"> <col style="mso-width-source:userset;mso-width-alt:4315;width:89pt" width="118"> <col style="mso-width-source:userset;mso-width-alt:3584;width:74pt" width="98"> <col style="mso-width-source:userset;mso-width-alt:3547;width:73pt" width="97"> <col style="mso-width-source:userset;mso-width-alt:4096;width:84pt" width="112"> </colgroup><tbody>
</tbody>

	A	B	C	D	E	F
1
2
3						10/12/2014
4	Debtor Name	Date	Document	Description	Debit	Credit
5
6	Company ABCD	13/3/2010	CRN - 13031001	CREDIT NOTE	0,00	2.200,00
7
8	Company EFGH	25/8/2010	CRN - 25081001	CREDIT NOTE	0,00	225,00

<colgroup><col style="mso-width-source:userset;mso-width-alt:2048;width:42pt" width="56"> <col style="mso-width-source:userset;mso-width-alt:3840;width:79pt" width="105"> <col style="mso-width-source:userset;mso-width-alt:3108;width:64pt" width="85"> <col style="mso-width-source:userset;mso-width-alt:4315;width:89pt" width="118"> <col style="mso-width-source:userset;mso-width-alt:3584;width:74pt" width="98"> <col style="mso-width-source:userset;mso-width-alt:3547;width:73pt" width="97"> <col style="mso-width-source:userset;mso-width-alt:4096;width:84pt" width="112"> </colgroup><tbody>
</tbody>

 

[onlyadrafter]

Hello,

not very elegant, but seems to work (on your sample data anyway).

Sub COMBINE()
    Application.ScreenUpdating = False
    MY_DATE = Range("F3").Value - 365
    For MY_ROWS = Range("B" & Rows.Count).End(xlUp).Row To 6 Step -1
        If Range("B" & MY_ROWS).Value < MY_DATE And Not (IsEmpty(Range("B" & MY_ROWS - 1).Value)) Then
            If Left(Range("C" & MY_ROWS).Value, 3) = "COR" Or _
                Left(Range("C" & MY_ROWS).Value, 3) = "CRN" Then
                    MY_TOTAL = MY_TOTAL + Range("F" & MY_ROWS).Value
            End If
        Else
            If IsEmpty(Range("B" & MY_ROWS - 1).Value) Then
                Range("B" & MY_ROWS & ":F" & MY_ROWS).Copy
                Range("B" & MY_ROWS - 1).PasteSpecial (xlPasteAll)
                MY_TOTAL = MY_TOTAL + Range("F" & MY_ROWS).Value
                Range("F" & MY_ROWS - 1).Value = MY_TOTAL
                Rows(MY_ROWS).Delete
                MY_ROWS = MY_ROWS - 1
                MY_TOTAL = 0
                GoTo CONT
            End If
        End If
        Rows(MY_ROWS).Delete
CONT:
    Next MY_ROWS
    Application.ScreenUpdating = True
End Sub

 

[Panoos64]

Hi onlyadrafter, somehow it seems to work but maybe need to be corrected the function for deleted rows. The VBA code keeps and other transactions types e.g. "INV". When i run the code should be sum for each debtor its transactions which contains in col. "C" the transactions types with letters "CRN" and "COR" and are over 365 days combining the today date in cell "F3" with transaction date in col "B" Any other transactions should be delete entire row. However great thanks for the time you spend for my project.

 

[onlyadrafter]

Hello,

when I ran my code, I got the same results as you posted in your original post.

From what you originally posted, what isn't working correctly.

I have assumed that all the data is laid out the same as your example, i.e. company name is on its own line with the other data beneath.

 

[Panoos64]

Hi again, You have right, for my extract i present, it works correctly. Just note that an extract of my data and the whole data when i download them, consists more than 30000 rows. We have to note that in my example just i present only 2 transactions types (CRN & COR). In my actual data there are some more like "INV", "REC", "ADJ" which the code doesn't delete their rows. Also i tested several times and there are CRN or COR which should be keep the rows and are over one year, but the code delete them. Anyway I am shy to bother you or discomfort you any more. Great thanks for the work you done for my project, really i appreciated and it was very kind of you. Thanks once again and i wish you all the best.

 

[onlyadrafter]

Hello,

so you want to keep rows of data that aren't over a year old.

Sub COMBINE()
    Application.ScreenUpdating = False
    MY_DATE = Range("F3").Value - 365
    For MY_ROWS = Range("B" & Rows.Count).End(xlUp).Row To 6 Step -1
        If Range("B" & MY_ROWS).Value < MY_DATE And Not (IsEmpty(Range("B" & MY_ROWS - 1).Value)) Then
            If Left(Range("C" & MY_ROWS).Value, 3) = "COR" Or _
                Left(Range("C" & MY_ROWS).Value, 3) = "CRN" Then
                    MY_TOTAL = MY_TOTAL + Range("F" & MY_ROWS).Value
                    Rows(MY_ROWS).Delete
            End If
        Else
            If IsEmpty(Range("B" & MY_ROWS - 1).Value) Then
                Range("B" & MY_ROWS & ":F" & MY_ROWS).Copy
                Range("B" & MY_ROWS - 1).PasteSpecial (xlPasteAll)
                MY_TOTAL = MY_TOTAL + Range("F" & MY_ROWS).Value
                Range("F" & MY_ROWS - 1).Value = MY_TOTAL
                Rows(MY_ROWS).Delete
                MY_ROWS = MY_ROWS - 1
                MY_TOTAL = 0
                GoTo CONT
            End If
        End If
CONT:
    Next MY_ROWS
    Application.ScreenUpdating = True
End Sub

This should keep rows of data that are less than a year old, and keeps rows that aren't COR or CRN.

 

[Panoos64]

Hi again, No is not exactly what you say. I need the code to keep "CRN and "COR" which are belong to the current year. (are not over a year old). Any other row should be deleted. Thanks once again for your attempt to resolve my matter. All the best.