I am having trouble writing a code that performs a sum if calculation
on a dynamic range of cells. For each "item" I want 1 row that sums
the totals for each date. See below:


I currently have this data on Sheet 1.

11.01 11.02 11.03 11.04 11.05
1 4 5 6 7 8
1 9 10 11 12 13
1 14 15 16 17 18
2 19 20 21 22 23
2 24 25 26 27 28
2 29 30 31 32 33
3 34 35 36 37 38
3 39 40 41 42 23
3 44 45 46 47 48

I built a macro to get this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1
2
3

Ultimately I want this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1 27 20 33 36 39
2 72 75 57 81 84
3 117 120 123 126 109


What is the best way to populate this matrix. The number of dates and
"items" will change.

This is what I current have, but I can't figure out how to sum across
rows to populate sheet 2.

Any ideas?

Sub Unique2()
Dim cLastRow As Long
Dim i As Long
Dim j As Long
Dim thisValue As Long
Dim isUnique As Boolean
Dim outputRow As Long

outputRow = 1

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row


For i = 1 To cLastRow

thisValue = Cells(i, 1)
isUnique = True

If Not i = cLastRow Then

For j = i + 1 To cLastRow

If thisValue = Cells(j, 1) Then isUnique = False

Next j

End If



If isUnique Then

'output somewhere
Sheet2.Cells(outputRow, 1) = thisValue
outputRow = outputRow + 1


End If
Next i
End Sub


Sub CopyDateRange()

Rows("1:1").Select
Selection.Copy
Sheets("Sheet2").Select
Rows("1:1").Select
ActiveSheet.Paste
End Sub

Hi

In your output have the macro put in the SUMIF formula (or SUMPRODUCT) and reference the formula to the source data. If you don't want the formula to remain in the output, then copy the results and then value paste. You only have to build the formula into one cell, then you can copy / paste or use fill.


Tony

----- future wrote: -----

I am having trouble writing a code that performs a sum if calculation
on a dynamic range of cells. For each "item" I want 1 row that sums
the totals for each date. See below:


I currently have this data on Sheet 1.

11.01 11.02 11.03 11.04 11.05
1 4 5 6 7 8
1 9 10 11 12 13
1 14 15 16 17 18
2 19 20 21 22 23
2 24 25 26 27 28
2 29 30 31 32 33
3 34 35 36 37 38
3 39 40 41 42 23
3 44 45 46 47 48

I built a macro to get this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1
2
3

Ultimately I want this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1 27 20 33 36 39
2 72 75 57 81 84
3 117 120 123 126 109


What is the best way to populate this matrix. The number of dates and
"items" will change.

This is what I current have, but I can't figure out how to sum across
rows to populate sheet 2.

Any ideas?

Sub Unique2()
Dim cLastRow As Long
Dim i As Long
Dim j As Long
Dim thisValue As Long
Dim isUnique As Boolean
Dim outputRow As Long

outputRow = 1

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row


For i = 1 To cLastRow

thisValue = Cells(i, 1)
isUnique = True

If Not i = cLastRow Then

For j = i + 1 To cLastRow

If thisValue = Cells(j, 1) Then isUnique = False

Next j

End If



If isUnique Then

'output somewhere
Sheet2.Cells(outputRow, 1) = thisValue
outputRow = outputRow + 1


End If
Next i
End Sub


Sub CopyDateRange()

Rows("1:1").Select
Selection.Copy
Sheets("Sheet2").Select
Rows("1:1").Select
ActiveSheet.Paste
End Sub

thanks tony,

but how do i indicate how many cells to populate? how many intersections
of dates and "items" to fill?



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

Hi,

Try this (watch wrap around on the formula in the middle)

Sub Unique2()
Dim cLastRow As Long
Dim cLastCol As Long
Dim i As Long
Dim j As Long
Dim thisValue As Long
Dim isUnique As Boolean
Dim outputRow As Long

outputRow = 2

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
cLastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Rows(1).Copy Destination:=Sheet2.Cells(1, 1)

For i = 2 To cLastRow

If Cells(i, 1).Value < Cells(i - 1, 1).Value Then
Sheet2.Cells(outputRow, 1).Value = Cells(i, 1).Value
For j = 2 To cLastCol
Sheet2.Cells(outputRow, j).FormulaR1C1 =
"=SUMPRODUCT((Sheet1!R1C2:R1C" & cLastCol & "=Sheet2!R1C)*(Sheet1!R2C1:R" &
cLastRow & "C1=Sheet2!RC1),Sheet1!R2C2:R" & cLastRow & "C" & cLastCol & ")"
Next j
outputRow = outputRow + 1
End If

Next i

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"future" wrote in message
om...
I am having trouble writing a code that performs a sum if calculation
on a dynamic range of cells. For each "item" I want 1 row that sums
the totals for each date. See below:


I currently have this data on Sheet 1.

11.01 11.02 11.03 11.04 11.05
1 4 5 6 7 8
1 9 10 11 12 13
1 14 15 16 17 18
2 19 20 21 22 23
2 24 25 26 27 28
2 29 30 31 32 33
3 34 35 36 37 38
3 39 40 41 42 23
3 44 45 46 47 48

I built a macro to get this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1
2
3

Ultimately I want this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1 27 20 33 36 39
2 72 75 57 81 84
3 117 120 123 126 109


What is the best way to populate this matrix. The number of dates and
"items" will change.

This is what I current have, but I can't figure out how to sum across
rows to populate sheet 2.

Any ideas?

Sub Unique2()
Dim cLastRow As Long
Dim i As Long
Dim j As Long
Dim thisValue As Long
Dim isUnique As Boolean
Dim outputRow As Long

outputRow = 1

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row


For i = 1 To cLastRow

thisValue = Cells(i, 1)
isUnique = True

If Not i = cLastRow Then

For j = i + 1 To cLastRow

If thisValue = Cells(j, 1) Then isUnique = False

Next j

End If



If isUnique Then

'output somewhere
Sheet2.Cells(outputRow, 1) = thisValue
outputRow = outputRow + 1


End If
Next i
End Sub


Sub CopyDateRange()

Rows("1:1").Select
Selection.Copy
Sheets("Sheet2").Select
Rows("1:1").Select
ActiveSheet.Paste
End Sub

Hello All:

This approach works. It also copies the Date headers and vertical index
numbers.


Sub SumMatrix()
Dim i As Integer, j As Integer
Dim rng As Range, c As Range
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim lLastRow As Long, lSum As Long

Set Sh1 = ThisWorkbook.Worksheets("Sheet1")
Set Sh2 = ThisWorkbook.Worksheets("Sheet2")

Set rng = Sh1.Range("1:1").Find(What:="", Lookat:=xlPart)
lLastRow = Sh1.Cells(Rows.Count, "A").End(xlUp).Row

i = 1
j = 1

For j = 1 To rng.Column - 2
lSum = 0
Sh2.Range("A1").Offset(0, j).Value = Sh1.Range("A1").Offset(0,
j).Value

For i = 1 To Sh1.Range("A" & lLastRow).Value
Sh2.Range("A1").Offset(i, 0).Value = i
lSum = 0
For Each c In Sh1.Range("A2:A" & lLastRow)
If c.Value = i Then
lSum = lSum + c.Offset(0, j).Value
Sh2.Range("A1").Offset(i, j).Value = lSum
End If
Next c
lSum = 0
Next i
Next j

Set Sh1 = Nothing
Set Sh2 = Nothing
Set rng = Nothing
End Sub

Regards,
Jim Feaver


"Bob Phillips" wrote in message
...
Hi,

Try this (watch wrap around on the formula in the middle)

Sub Unique2()
Dim cLastRow As Long
Dim cLastCol As Long
Dim i As Long
Dim j As Long
Dim thisValue As Long
Dim isUnique As Boolean
Dim outputRow As Long

outputRow = 2

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
cLastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Rows(1).Copy Destination:=Sheet2.Cells(1, 1)

For i = 2 To cLastRow

If Cells(i, 1).Value < Cells(i - 1, 1).Value Then
Sheet2.Cells(outputRow, 1).Value = Cells(i, 1).Value
For j = 2 To cLastCol
Sheet2.Cells(outputRow, j).FormulaR1C1 =
"=SUMPRODUCT((Sheet1!R1C2:R1C" & cLastCol & "=Sheet2!R1C)*(Sheet1!R2C1:R"
&
cLastRow & "C1=Sheet2!RC1),Sheet1!R2C2:R" & cLastRow & "C" & cLastCol &
")"
Next j
outputRow = outputRow + 1
End If

Next i

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"future" wrote in message
om...
I am having trouble writing a code that performs a sum if calculation
on a dynamic range of cells. For each "item" I want 1 row that sums
the totals for each date. See below:


I currently have this data on Sheet 1.

11.01 11.02 11.03 11.04 11.05
1 4 5 6 7 8
1 9 10 11 12 13
1 14 15 16 17 18
2 19 20 21 22 23
2 24 25 26 27 28
2 29 30 31 32 33
3 34 35 36 37 38
3 39 40 41 42 23
3 44 45 46 47 48

I built a macro to get this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1
2
3

Ultimately I want this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1 27 20 33 36 39
2 72 75 57 81 84
3 117 120 123 126 109


What is the best way to populate this matrix. The number of dates and
"items" will change.

This is what I current have, but I can't figure out how to sum across
rows to populate sheet 2.

Any ideas?

Sub Unique2()
Dim cLastRow As Long
Dim i As Long
Dim j As Long
Dim thisValue As Long
Dim isUnique As Boolean
Dim outputRow As Long

outputRow = 1

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row


For i = 1 To cLastRow

thisValue = Cells(i, 1)
isUnique = True

If Not i = cLastRow Then

For j = i + 1 To cLastRow

If thisValue = Cells(j, 1) Then isUnique = False

Next j

End If



If isUnique Then

'output somewhere
Sheet2.Cells(outputRow, 1) = thisValue
outputRow = outputRow + 1


End If
Next i
End Sub


Sub CopyDateRange()

Rows("1:1").Select
Selection.Copy
Sheets("Sheet2").Select
Rows("1:1").Select
ActiveSheet.Paste
End Sub

Jim,

May I suggest that my solution has one big advantage over yours (I would say
that<G?

If another column or row is inserted in the middle of the source data, or a
value is changed, the target data will automatically update without the need
to re-run, as I create formulae, not values.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Jim Feaver" wrote in message
news:zXiUb.404709$ts4.199024@pd7tw3no...
Hello All:

This approach works. It also copies the Date headers and vertical index
numbers.


Sub SumMatrix()
Dim i As Integer, j As Integer
Dim rng As Range, c As Range
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim lLastRow As Long, lSum As Long

Set Sh1 = ThisWorkbook.Worksheets("Sheet1")
Set Sh2 = ThisWorkbook.Worksheets("Sheet2")

Set rng = Sh1.Range("1:1").Find(What:="", Lookat:=xlPart)
lLastRow = Sh1.Cells(Rows.Count, "A").End(xlUp).Row

i = 1
j = 1

For j = 1 To rng.Column - 2
lSum = 0
Sh2.Range("A1").Offset(0, j).Value = Sh1.Range("A1").Offset(0,
j).Value

For i = 1 To Sh1.Range("A" & lLastRow).Value
Sh2.Range("A1").Offset(i, 0).Value = i
lSum = 0
For Each c In Sh1.Range("A2:A" & lLastRow)
If c.Value = i Then
lSum = lSum + c.Offset(0, j).Value
Sh2.Range("A1").Offset(i, j).Value = lSum
End If
Next c
lSum = 0
Next i
Next j

Set Sh1 = Nothing
Set Sh2 = Nothing
Set rng = Nothing
End Sub

Regards,
Jim Feaver


"Bob Phillips" wrote in message
...
Hi,

Try this (watch wrap around on the formula in the middle)

Sub Unique2()
Dim cLastRow As Long
Dim cLastCol As Long
Dim i As Long
Dim j As Long
Dim thisValue As Long
Dim isUnique As Boolean
Dim outputRow As Long

outputRow = 2

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
cLastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Rows(1).Copy Destination:=Sheet2.Cells(1, 1)

For i = 2 To cLastRow

If Cells(i, 1).Value < Cells(i - 1, 1).Value Then
Sheet2.Cells(outputRow, 1).Value = Cells(i, 1).Value
For j = 2 To cLastCol
Sheet2.Cells(outputRow, j).FormulaR1C1 =
"=SUMPRODUCT((Sheet1!R1C2:R1C" & cLastCol &
"=Sheet2!R1C)*(Sheet1!R2C1:R"
&
cLastRow & "C1=Sheet2!RC1),Sheet1!R2C2:R" & cLastRow & "C" & cLastCol &
")"
Next j
outputRow = outputRow + 1
End If

Next i

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"future" wrote in message
om...
I am having trouble writing a code that performs a sum if calculation
on a dynamic range of cells. For each "item" I want 1 row that sums
the totals for each date. See below:


I currently have this data on Sheet 1.

11.01 11.02 11.03 11.04 11.05
1 4 5 6 7 8
1 9 10 11 12 13
1 14 15 16 17 18
2 19 20 21 22 23
2 24 25 26 27 28
2 29 30 31 32 33
3 34 35 36 37 38
3 39 40 41 42 23
3 44 45 46 47 48

I built a macro to get this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1
2
3

Ultimately I want this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1 27 20 33 36 39
2 72 75 57 81 84
3 117 120 123 126 109


What is the best way to populate this matrix. The number of dates and
"items" will change.

This is what I current have, but I can't figure out how to sum across
rows to populate sheet 2.

Any ideas?

Sub Unique2()
Dim cLastRow As Long
Dim i As Long
Dim j As Long
Dim thisValue As Long
Dim isUnique As Boolean
Dim outputRow As Long

outputRow = 1

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row


For i = 1 To cLastRow

thisValue = Cells(i, 1)
isUnique = True

If Not i = cLastRow Then

For j = i + 1 To cLastRow

If thisValue = Cells(j, 1) Then isUnique = False

Next j

End If



If isUnique Then

'output somewhere
Sheet2.Cells(outputRow, 1) = thisValue
outputRow = outputRow + 1


End If
Next i
End Sub


Sub CopyDateRange()

Rows("1:1").Select
Selection.Copy
Sheets("Sheet2").Select
Rows("1:1").Select
ActiveSheet.Paste
End Sub

Good point.
Thanks, Bob
Regards,
Jim Feaver

"Bob Phillips" wrote in message
...
Jim,

May I suggest that my solution has one big advantage over yours (I would
say
that<G?

If another column or row is inserted in the middle of the source data, or
a
value is changed, the target data will automatically update without the
need
to re-run, as I create formulae, not values.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Jim Feaver" wrote in message
news:zXiUb.404709$ts4.199024@pd7tw3no...
Hello All:

This approach works. It also copies the Date headers and vertical index
numbers.


Sub SumMatrix()
Dim i As Integer, j As Integer
Dim rng As Range, c As Range
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim lLastRow As Long, lSum As Long

Set Sh1 = ThisWorkbook.Worksheets("Sheet1")
Set Sh2 = ThisWorkbook.Worksheets("Sheet2")

Set rng = Sh1.Range("1:1").Find(What:="", Lookat:=xlPart)
lLastRow = Sh1.Cells(Rows.Count, "A").End(xlUp).Row

i = 1
j = 1

For j = 1 To rng.Column - 2
lSum = 0
Sh2.Range("A1").Offset(0, j).Value = Sh1.Range("A1").Offset(0,
j).Value

For i = 1 To Sh1.Range("A" & lLastRow).Value
Sh2.Range("A1").Offset(i, 0).Value = i
lSum = 0
For Each c In Sh1.Range("A2:A" & lLastRow)
If c.Value = i Then
lSum = lSum + c.Offset(0, j).Value
Sh2.Range("A1").Offset(i, j).Value = lSum
End If
Next c
lSum = 0
Next i
Next j

Set Sh1 = Nothing
Set Sh2 = Nothing
Set rng = Nothing
End Sub

Regards,
Jim Feaver


"Bob Phillips" wrote in message
...
Hi,

Try this (watch wrap around on the formula in the middle)

Sub Unique2()
Dim cLastRow As Long
Dim cLastCol As Long
Dim i As Long
Dim j As Long
Dim thisValue As Long
Dim isUnique As Boolean
Dim outputRow As Long

outputRow = 2

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
cLastCol = Cells(1, Columns.Count).End(xlToLeft).Column

Rows(1).Copy Destination:=Sheet2.Cells(1, 1)

For i = 2 To cLastRow

If Cells(i, 1).Value < Cells(i - 1, 1).Value Then
Sheet2.Cells(outputRow, 1).Value = Cells(i, 1).Value
For j = 2 To cLastCol
Sheet2.Cells(outputRow, j).FormulaR1C1 =
"=SUMPRODUCT((Sheet1!R1C2:R1C" & cLastCol &
"=Sheet2!R1C)*(Sheet1!R2C1:R"
&
cLastRow & "C1=Sheet2!RC1),Sheet1!R2C2:R" & cLastRow & "C" & cLastCol
&
")"
Next j
outputRow = outputRow + 1
End If

Next i

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"future" wrote in message
om...
I am having trouble writing a code that performs a sum if
calculation
on a dynamic range of cells. For each "item" I want 1 row that sums
the totals for each date. See below:


I currently have this data on Sheet 1.

11.01 11.02 11.03 11.04 11.05
1 4 5 6 7 8
1 9 10 11 12 13
1 14 15 16 17 18
2 19 20 21 22 23
2 24 25 26 27 28
2 29 30 31 32 33
3 34 35 36 37 38
3 39 40 41 42 23
3 44 45 46 47 48

I built a macro to get this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1
2
3

Ultimately I want this on Sheet 2.

11.01 11.02 11.03 11.04 11.05
1 27 20 33 36 39
2 72 75 57 81 84
3 117 120 123 126 109


What is the best way to populate this matrix. The number of dates
and
"items" will change.

This is what I current have, but I can't figure out how to sum
across
rows to populate sheet 2.

Any ideas?

Sub Unique2()
Dim cLastRow As Long
Dim i As Long
Dim j As Long
Dim thisValue As Long
Dim isUnique As Boolean
Dim outputRow As Long

outputRow = 1

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row


For i = 1 To cLastRow

thisValue = Cells(i, 1)
isUnique = True

If Not i = cLastRow Then

For j = i + 1 To cLastRow

If thisValue = Cells(j, 1) Then isUnique = False

Next j

End If



If isUnique Then

'output somewhere
Sheet2.Cells(outputRow, 1) = thisValue
outputRow = outputRow + 1


End If
Next i
End Sub


Sub CopyDateRange()

Rows("1:1").Select
Selection.Copy
Sheets("Sheet2").Select
Rows("1:1").Select
ActiveSheet.Paste
End Sub

Beautiful Guys
Thank You!



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

WAIT but what if the like "items" are not in sequential rows. what if
you add a row at the bottem with item = 1???

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!