Hi All,
I am looking for some clean up help with the spread sheet I get quite often.
There are 2 parts I am pasting under this msg. 1st is the original
spreadshhet & 2nd part consist after the manual cleanup & formaula used.
Column A is item type. If they are same & has same date then combine all item
A and add Col B, Col E, Col F, Col G, Col H. Column C should be (the total of
E divided by total of B). I know its confusing but not really( I hope I am
not making it more complicated)
Any help in automizing this with a click of a button will be great hlp.

Thanks
An

A B C D E F G H
It 1 -500 19.1 12/29/2005 -$9,550.00 0 0.40 -$9,549.60
It 1 -100 19.1 12/29/2005 -$1,910.00 0 0.08 -$1,909.92
It 1 -200 19.1 12/29/2005 -$3,820.00 7 0.16 -$3,812.84
It 2 -900 20.53 12/28/2005 -$18,477.00 7 0.78 -$18,469.22
It 3 -1000 17.55 12/27/2005 -$17,550.00 7 0.74 -$17,542.26
It 1 -500 18.68 12/23/2005 -$9,340.00 0 0.40 -$9,339.60
It 1 -300 18.67 12/23/2005 -$5,601.00 7 0.24 -$5,593.76
It 2 -500 20.32 12/22/2005 -$10,160.60 0 0.43 -$10,160.17
It 2 -400 20.32 12/22/2005 -$8,128.00 0 0.34 -$8,127.66
It 2 -100 20.32 12/22/2005 -$2,032.00 7 0.09 -$2,024.91
It 1 -100 19.58 12/21/2005 -$1,958.00 0 0.09 -$1,957.91
It 1 -650 19.58 12/21/2005 -$12,727.00 7 0.54 -$12,719.46
It 1 -1000 20.71 12/20/2005 -$20,710.00 7 0.87 -$20,702.13
It 4 -68 19.09 12/19/2005 -$1,298.12 0 0.06 -$1,298.06
It 4 -500 19.09 12/19/2005 -$9,545.00 0 0.40 -$9,544.60
It 4 -432 19.09 12/19/2005 -$8,246.88 7 0.35 -$8,239.53
It 4 -1000 18.43 12/09/2005 -$18,430.00 7 0.78 -$18,422.22


It 1 -800 19.1 12/29/2005 -$15,280.00 7 0.64 $(15,272.36)
It 2 -900 20.53 12/28/2005 -$18,477.00 7 0.78 $(18,469.22)
It 3 -1000 17.55 12/27/2005 -$17,550.00 7 0.74 $(17,542.26)
It 1 -800 18.67 12/23/2005 -$14,941.00 7 0.64 $(14,933.36)
It 2 -1000 20.32 12/22/2005 -$20,320.60 7 0.86 $(20,312.74)
It 1 -750 19.58 12/21/2005 -$14,685.00 7 0.63 $(14,677.37)
It 1 -1000 20.71 12/20/2005 -$20,710.00 7 0.87 $(20,702.13)
It 4 -2000 18.76 12/09/2005 -$37,520.00 7 1.59 $(37,504.41)

I just aligned it little bit.
---------------------------------------------------------------------
Before
---------------------------------------------------------------------
A |B |C |D |E |F |G |H |I
--|------|--------|-----|----------|-----------|----|----|-----------
1 |"It 1"|-500.00 |19.10|12/29/2005|($9550.00) |0.00|0.40|($9549.60)
2 |"It 1"|-100.00 |19.10|12/29/2005|($1910.00) |0.00|0.08|($1909.92)
3 |"It 1"|-200.00 |19.10|12/29/2005|($3820.00) |7.00|0.16|($3812.84)
4 |"It 2"|-900.00 |20.53|12/28/2005|($18477.00)|7.00|0.78|($18469.22)
5 |"It 3"|-1000.00|17.55|12/27/2005|($17550.00)|7.00|0.74|($17542.26)
6 |"It 1"|-500.00 |18.68|12/23/2005|($9340.00) |0.00|0.40|($9339.60)
7 |"It 1"|-300.00 |18.67|12/23/2005|($5601.00) |7.00|0.24|($5593.76)
8 |"It 2"|-500.00 |20.32|12/22/2005|($10160.60)|0.00|0.43|($10160.17)
9 |"It 2"|-400.00 |20.32|12/22/2005|($8128.00) |0.00|0.34|($8127.66)
10|"It 2"|-100.00 |20.32|12/22/2005|($2032.00) |7.00|0.09|($2024.91)
11|"It 1"|-100.00 |19.58|12/21/2005|($1958.00) |0.00|0.09|($1957.91)
12|"It 1"|-650.00 |19.58|12/21/2005|($12727.00)|7.00|0.54|($12719.46)
13|"It 1"|-1000.00|20.71|12/20/2005|($20710.00)|7.00|0.87|($20702.13)
14|"It 4"|-68.00 |19.09|12/19/2005|($1298.12) |0.00|0.06|($1298.06)
15|"It 4"|-500.00 |19.09|12/19/2005|($9545.00) |0.00|0.40|($9544.60)
16|"It 4"|-432.00 |19.09|12/19/2005|($8246.88) |7.00|0.35|($8239.53)
17|"It 4"|-1000.00|18.43|12/09/2005|($18430.00)|7.00|0.78|($18422.22)
---------------------------------------------------------------------

---------------------------------------------------------------------
After
---------------------------------------------------------------------
20|"It 1"|-800.00 |19.10|12/29/2005|($15280.00)|7.00|0.64|($15272.36)
21|"It 2"|-900.00 |20.53|12/28/2005|($18477.00)|7.00|0.78|($18469.22)
22|"It 3"|-1000.00|17.55|12/27/2005|($17550.00)|7.00|0.74|($17542.26)
23|"It 1"|-800.00 |18.67|12/23/2005|($14941.00)|7.00|0.64|($14933.36)
24|"It 2"|-1000.00|20.32|12/22/2005|($20320.60)|7.00|0.86|($20312.74)
25|"It 1"|-750.00 |19.58|12/21/2005|($14685.00)|7.00|0.63|($14677.37)
26|"It 1"|-1000.00|20.71|12/20/2005|($20710.00)|7.00|0.87|($20702.13)
27|"It 4"|-2000.00|18.76|12/09/2005|($37520.00)|7.00|1.59|($37504.41)
---------------------------------------------------------------------

Here's a code to do the trick (maybe not the cleanest/clearest but
still...):

***
Sub CleanUp()
Dim i As Integer, j As Integer
Dim intRows As Integer, intCols As Integer
Dim rngCount As Range
Dim tot()

intCols = 7
ReDim tot(10, intCols)
j = 0

Set rngCount = Range("A:A")
intRows = WorksheetFunction.CountA(rngCount) + 1

For i = 2 To intRows
If Cells(i - 1, 1) = Cells(i, 1) Then
If Cells(i - 1, 4) = Cells(i, 4) Then
tot(j, 1) = tot(j, 1) + Cells(i - 1, 2)
tot(j, 4) = tot(j, 4) + Cells(i - 1, 5)
tot(j, 5) = tot(j, 5) + Cells(i - 1, 6)
tot(j, 6) = tot(j, 6) + Cells(i - 1, 7)
tot(j, 7) = tot(j, 7) + Cells(i - 1, 8)
Else
tot(j, 0) = Cells(i - 1, 1)
tot(j, 1) = tot(j, 1) + Cells(i - 1, 2)
tot(j, 4) = tot(j, 4) + Cells(i - 1, 5)
tot(j, 5) = tot(j, 5) + Cells(i - 1, 6)
tot(j, 6) = tot(j, 6) + Cells(i - 1, 7)
tot(j, 7) = tot(j, 7) + Cells(i - 1, 8)
tot(j, 2) = tot(j, 4) / tot(j, 1)
tot(j, 3) = Cells(i - 1, 4)
j = j + 1
End If
Else
tot(j, 0) = Cells(i - 1, 1)
tot(j, 1) = tot(j, 1) + Cells(i - 1, 2)
tot(j, 4) = tot(j, 4) + Cells(i - 1, 5)
tot(j, 5) = tot(j, 5) + Cells(i - 1, 6)
tot(j, 6) = tot(j, 6) + Cells(i - 1, 7)
tot(j, 7) = tot(j, 7) + Cells(i - 1, 8)
tot(j, 2) = tot(j, 4) / tot(j, 1)
tot(j, 3) = Cells(i - 1, 4)
j = j + 1
End If
Next i

For i = 0 To UBound(tot()) - 1
For j = 0 To intCols
Cells(i + intRows + 3, j + 1) = tot(i, j)
Next j
Next i

End Sub
***

btw. you have date in either the rows 14-16 wrong or in 17 and summary
;)

regs,
JK

Thanks Guys. I will give it a try

Andy

"JK" wrote:

Here's a code to do the trick (maybe not the cleanest/clearest but
still...):

***
Sub CleanUp()
Dim i As Integer, j As Integer
Dim intRows As Integer, intCols As Integer
Dim rngCount As Range
Dim tot()

intCols = 7
ReDim tot(10, intCols)
j = 0

Set rngCount = Range("A:A")
intRows = WorksheetFunction.CountA(rngCount) + 1

For i = 2 To intRows
If Cells(i - 1, 1) = Cells(i, 1) Then
If Cells(i - 1, 4) = Cells(i, 4) Then
tot(j, 1) = tot(j, 1) + Cells(i - 1, 2)
tot(j, 4) = tot(j, 4) + Cells(i - 1, 5)
tot(j, 5) = tot(j, 5) + Cells(i - 1, 6)
tot(j, 6) = tot(j, 6) + Cells(i - 1, 7)
tot(j, 7) = tot(j, 7) + Cells(i - 1, 8)
Else
tot(j, 0) = Cells(i - 1, 1)
tot(j, 1) = tot(j, 1) + Cells(i - 1, 2)
tot(j, 4) = tot(j, 4) + Cells(i - 1, 5)
tot(j, 5) = tot(j, 5) + Cells(i - 1, 6)
tot(j, 6) = tot(j, 6) + Cells(i - 1, 7)
tot(j, 7) = tot(j, 7) + Cells(i - 1, 8)
tot(j, 2) = tot(j, 4) / tot(j, 1)
tot(j, 3) = Cells(i - 1, 4)
j = j + 1
End If
Else
tot(j, 0) = Cells(i - 1, 1)
tot(j, 1) = tot(j, 1) + Cells(i - 1, 2)
tot(j, 4) = tot(j, 4) + Cells(i - 1, 5)
tot(j, 5) = tot(j, 5) + Cells(i - 1, 6)
tot(j, 6) = tot(j, 6) + Cells(i - 1, 7)
tot(j, 7) = tot(j, 7) + Cells(i - 1, 8)
tot(j, 2) = tot(j, 4) / tot(j, 1)
tot(j, 3) = Cells(i - 1, 4)
j = j + 1
End If
Next i

For i = 0 To UBound(tot()) - 1
For j = 0 To intCols
Cells(i + intRows + 3, j + 1) = tot(i, j)
Next j
Next i

End Sub
***

btw. you have date in either the rows 14-16 wrong or in 17 and summary
;)

regs,
JK

Thanks Guys. I will give it a try

Andy

"JK" wrote:

Here's a code to do the trick (maybe not the cleanest/clearest but
still...):

***
Sub CleanUp()
Dim i As Integer, j As Integer
Dim intRows As Integer, intCols As Integer
Dim rngCount As Range
Dim tot()

intCols = 7
ReDim tot(10, intCols)
j = 0

Set rngCount = Range("A:A")
intRows = WorksheetFunction.CountA(rngCount) + 1

For i = 2 To intRows
If Cells(i - 1, 1) = Cells(i, 1) Then
If Cells(i - 1, 4) = Cells(i, 4) Then
tot(j, 1) = tot(j, 1) + Cells(i - 1, 2)
tot(j, 4) = tot(j, 4) + Cells(i - 1, 5)
tot(j, 5) = tot(j, 5) + Cells(i - 1, 6)
tot(j, 6) = tot(j, 6) + Cells(i - 1, 7)
tot(j, 7) = tot(j, 7) + Cells(i - 1, 8)
Else
tot(j, 0) = Cells(i - 1, 1)
tot(j, 1) = tot(j, 1) + Cells(i - 1, 2)
tot(j, 4) = tot(j, 4) + Cells(i - 1, 5)
tot(j, 5) = tot(j, 5) + Cells(i - 1, 6)
tot(j, 6) = tot(j, 6) + Cells(i - 1, 7)
tot(j, 7) = tot(j, 7) + Cells(i - 1, 8)
tot(j, 2) = tot(j, 4) / tot(j, 1)
tot(j, 3) = Cells(i - 1, 4)
j = j + 1
End If
Else
tot(j, 0) = Cells(i - 1, 1)
tot(j, 1) = tot(j, 1) + Cells(i - 1, 2)
tot(j, 4) = tot(j, 4) + Cells(i - 1, 5)
tot(j, 5) = tot(j, 5) + Cells(i - 1, 6)
tot(j, 6) = tot(j, 6) + Cells(i - 1, 7)
tot(j, 7) = tot(j, 7) + Cells(i - 1, 8)
tot(j, 2) = tot(j, 4) / tot(j, 1)
tot(j, 3) = Cells(i - 1, 4)
j = j + 1
End If
Next i

For i = 0 To UBound(tot()) - 1
For j = 0 To intCols
Cells(i + intRows + 3, j + 1) = tot(i, j)
Next j
Next i

End Sub
***

btw. you have date in either the rows 14-16 wrong or in 17 and summary
;)

regs,
JK

Hi Andy,

You can olso use this:

Sub CombineLines
Range("A2").Select
' Combine Lines with same keyvalues
Do
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value And _
ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(-1,
3).Value Then
With ActiveCell
.Offset(-1, 1).Value = .Offset(-1, 1).Value + .Offset(,
1).Value
.Offset(-1, 4).Value = .Offset(-1, 4) + .Offset(0,
4).Value
.Offset(-1, 5).Value = .Offset(0, 5)
.Offset(-1, 6).Value = .Offset(-1, 6) + .Offset(0, 6)
.Offset(-1, 7).Value = .Offset(-1, 7) + .Offset(0, 7)
End With
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell)
' Recalc
Range("C1").Select
Do
ActiveCell.Value = ActiveCell.Offset(0, 2).Value /
ActiveCell.Offset(0, -1).Value
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Offset(0, -2))
End Sub

Hoop This Helps


Executor

"Andy" wrote in message
...
I just aligned it little bit.
---------------------------------------------------------------------
Before
---------------------------------------------------------------------
A |B |C |D |E |F |G |H |I
--|------|--------|-----|----------|-----------|----|----|-----------
1 |"It 1"|-500.00 |19.10|12/29/2005|($9550.00) |0.00|0.40|($9549.60)

Hi Andy

the table in your first post and second post is diffrent, so i followed second
post.
Item type is in column B. Select original sheet and run the macro sample below,
then this macro will duplicate original sheet and will cleanup that sheet.
But, I'm not sure this will work in your Table.

presume:
Item type is in column B and Date is in columnE.
Column D is column F divided by column B.

Sub sample()
Dim strow As Range, endrow As Range
Dim r1 As Long, r2 As Long

ActiveSheet.Copy after:=ActiveSheet
Range("B1").Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range("E1"),
Order2:=xlDescending, Header:=xlGuess

If VarType(Cells(1, "c")) < VBString Then
Set strow = Cells(1, "b")
Else
Set strow = Cells(2, "b")
End If
Set endrow = strow.Offset(1, 0)

Do While Not IsEmpty(endrow)
If strow.Value = endrow.Value And strow(1, 4).Value = endrow(1, 4).Value
Then
Set endrow = endrow.Offset(1, 0)
Else
r1 = strow.Row
r2 = endrow.Row - 1
Set strow = endrow
Set endrow = strow.Offset(1, 0)
strow.EntireRow.Insert
Cells(r2 + 1, "b") = Cells(r2, "b")
Cells(r2 + 1, "c") = Application.Sum(Range("c" & r1 & ":c" & r2))
Cells(r2 + 1, "e") = Cells(r2, "e")
Cells(r2 + 1, "f") = Application.Sum(Range("f" & r1 & ":f" & r2))
Cells(r2 + 1, "g") = Application.Sum(Range("g" & r1 & ":g" & r2))
Cells(r2 + 1, "h") = Application.Sum(Range("h" & r1 & ":h" & r2))
Cells(r2 + 1, "i") = Application.Sum(Range("i" & r1 & ":i" & r2))
Cells(r2 + 1, "d") = Application.RoundDown(Cells(r2 + 1, "f").Value /
Cells(r2 + 1, "c").Value, 2)
Rows(r1 & ":" & r2).Delete
End If
Loop
Range("B1").Sort Key1:=Range("E1"), Order1:=xlDescending, Header:=xlGuess
End Sub

keizi