Macro - To Include Summing All Similar Entries

S

steven.holloway

TABLE:
IGNORE OK REVERSE
BLANK Cost1 Cost2 Cost3
CC ID TEXT Cost1 Cost2 Cost3
1100 0000278 xxxx 100 5000 1000
1100 0001006 xxxx 100 5000 1000
2710 0001083 xxxx 100 1000
2710 0001170 xxxx 100 5000 1000
8400 0001228 xxxx 100 5000 1000

If you copy the above table into a worksheet called 'SOURCE' and create a
second called 'JOURNAL' & then copy the macro into the workbook and run you
should get the below table.

BASIC PAY 1100 5,000.00
BASIC PAY 1100 5,000.00
BASIC PAY 2710 5,000.00
BASIC PAY 8400 5,000.00
OVERTIME 2.0 1100 1,000.00
OVERTIME 2.0 1100 1,000.00
OVERTIME 2.0 2710 1,000.00
OVERTIME 2.0 2710 1,000.00
OVERTIME 2.0 8,400.00 1,000.00

However I would like to adjust the macro so that any matching Cost1 & Cost2
lines create 1 single line and not two. - The end table should look like this.

BASIC PAY 1100 10,000.00
BASIC PAY 2710 5,000.00
BASIC PAY 8400 5,000.00
OVERTIME 2.0 1100 2,000.00
OVERTIME 2.0 2710 2,000.00
OVERTIME 2.0 8400 1,000.00

The data above is only an extract and consists of more rows & columns (there
could be any number of same Cost1 & Cost2 in the list).

Many thanks in advance for any help possible.
Steve
 
S

steven.holloway

Sorry forgot the macro;

Sub Create_Journal()

Start_Cell = "A1"

With Sheets("SOURCE")
Last_Row = .Range(Start_Cell).Offset(3, 1).End(xlDown).Row
Last_Column = .Range(Start_Cell).Offset(0, 4).End(xlToRight).Column
Set Cost_Info_Range = .Range(.Range(Start_Cell).Offset(0, 4),
..Cells(Last_Column))
End With

Row_Count = 5

For Each Parent_Cell In Cost_Info_Range
If Parent_Cell = "OK" Then
Cost_Group = Cells(2, Parent_Cell.Column)
With Sheets("SOURCE")
Set Cost_Amount_Range = .Range(.Cells(Parent_Cell.Row,
Parent_Cell.Column).Offset(3, 0), .Cells(Last_Row, Parent_Cell.Column))
End With
For Each First_Child_Cell In Cost_Amount_Range
If First_Child_Cell <> 0 Then
Cost_Center = Cells(First_Child_Cell.Row, "B")
Cost_Amount = Cells(First_Child_Cell.Row,
First_Child_Cell.Column)
With Sheets("JOURNAL")
.Range("B" & Row_Count) = Cost_Group
.Range("C" & Row_Count) = Cost_Center
If First_Child_Cell > 0 Then
.Range("D" & Row_Count) = Cost_Amount
Else
.Range("E" & Row_Count) = Cost_Amount
End If
Row_Count = Row_Count + 1
End With
End If
Next First_Child_Cell
Else
If Parent_Cell = "REVERSE" Then
Cost_Group = Cells(2, Parent_Cell.Column)
With Sheets("SOURCE")
Set Cost_Amount_Range =
..Range(.Cells(Parent_Cell.Row, Parent_Cell.Column).Offset(3, 0),
..Cells(Last_Row, Parent_Cell.Column))
End With
For Each Second_Child_Cell In Cost_Amount_Range
If Second_Child_Cell <> 0 Then
Cost_Center = Cells(Second_Child_Cell.Row,
"B")
Cost_Amount = Cells(Second_Child_Cell.Row,
Second_Child_Cell.Column)
With Sheets("JOURNAL")
.Range("B" & Row_Count) = Cost_Group
.Range("C" & Row_Count) = Cost_Center
If Second_Child_Cell > 0 Then
.Range("E" & Row_Count) = Cost_Amount
Else
.Range("D" & Row_Count) = Cost_Amount
End If
Row_Count = Row_Count + 1
End With
End If
Next Second_Child_Cell
End If
End If
Next Parent_Cell

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top