Funky Summarizing

[SandsB]

Somebody posted a question about stock charts and I realized I have the same problem. I think I'm stating it better than the original post.
Every day I manually do this. I'm sure there's a better way. I've looked all over Pivot Tables and Subtotals and .....but just don't see how to do what I need. I want something that will read all of my data and give me output in a table format.

My data has these fields:
Date, starting volume, ending volume, refill volume, and some other stuff I don't care about. As in...
1/1/14, 412, 422, 418, other stuff
1/1/14, 82, 45, 912, other stuff
1/1/14, 54, 40, 28, other stuff
1/20/14, 9, 22, 20, other stuff
1/20/14. 111, 222, 333, other stuff

What I need is way to summarize all this to show me
Date, lowest starting volume on this date, highest ending volume on this date, highest refill volume on this date, lowest refill volume on this date.
1/1/14, 54, 422, 912, 28
1/20/14, 9, 222, 333, 20

Is there a way to do this with a pivot table? By magic?

 

[hiker95]

SandsB,

With your raw data already sorted/grouped by the date in column A:

How about a macro solution that will adjust for a varying number of rows, and, columns?

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K
1	Date	starting volume	ending volume	refill volume	other stuff
2	1/1/14	412	422	418	other stuff
3	1/1/14	82	45	912	other stuff
4	1/1/14	54	40	28	other stuff
5	1/20/14	9	22	20	other stuff
6	1/20/14	111	222	333	other stuff
7
Sheet1

After the macro:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K
1	Date	starting volume	ending volume	refill volume	other stuff		Date	lowest starting volume on this Date	highest ending volume on this Date	highest refill volume on this Date	lowest refill volume on this Date
2	1/1/14	412	422	418	other stuff		1/1/2014	54	422	912	28
3	1/1/14	82	45	912	other stuff		1/20/2014	9	222	333	20
4	1/1/14	54	40	28	other stuff
5	1/20/14	9	22	20	other stuff
6	1/20/14	111	222	333	other stuff
7
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, and, function
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ReorgData()
' hiker95, 09/03/2014, ME803099
Dim r As Long, lr As Long, lc As Long, luc As Long, nlr As Long, n As Long
Dim o As Variant, j As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, 1).End(xlToRight).Column
luc = Cells(1, Columns.Count).End(xlToLeft).Column
If luc > lc Then
  Columns(lc + 2).Resize(, luc - lc + 1).ClearContents
End If
Cells(1, lc + 2) = "Date"
Cells(1, lc + 3) = "lowest" & vbLf & "starting" & vbLf & "volume" & vbLf & "on this" & vbLf & "Date"
Cells(1, lc + 4) = "highest" & vbLf & "ending" & vbLf & "volume" & vbLf & "on this" & vbLf & "Date"
Cells(1, lc + 5) = "highest" & vbLf & "refill" & vbLf & "volume" & vbLf & "on this" & vbLf & "Date"
Cells(1, lc + 6) = "lowest" & vbLf & "refill" & vbLf & "volume" & vbLf & "on this" & vbLf & "Date"
With Range(Cells(1, lc + 2), Cells(1, lc + 6))
  .HorizontalAlignment = xlCenter
  .Columns.AutoFit
End With
Rows(1).AutoFit
nlr = CountUnique(Range("A2:A" & lr))
ReDim o(1 To nlr, 1 To 5)
For r = 2 To lr
  n = Application.CountIf(Columns(1), Cells(r, 1).Value)
  j = j + 1
  o(j, 1) = Cells(r, 1)
  o(j, 2) = WorksheetFunction.Min(Range("B" & r & ":B" & r + n - 1))
  o(j, 3) = WorksheetFunction.Max(Range("C" & r & ":C" & r + n - 1))
  o(j, 4) = WorksheetFunction.Max(Range("D" & r & ":D" & r + n - 1))
  o(j, 5) = WorksheetFunction.Min(Range("D" & r & ":D" & r + n - 1))
  r = r + n - 1
Next r
Cells(2, lc + 2).Resize(UBound(o, 1), UBound(o, 2)) = o
Columns(lc + 2).Resize(, luc - lc + 2).AutoFit
Application.ScreenUpdating = False
End Sub
Function CountUnique(ByVal Rng As Range) As Long
' Juan Pablo González, MrExcel MVP, 05/09/2003
' http://www.mrexcel.com/forum/excel-questions/48385-need-count-unique-items-column-visual-basic-applications.html
Dim St As String
Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
St = "'" & Rng.Parent.Name & "'!" & Rng.Address(False, False)
CountUnique = Evaluate("SUM(IF(LEN(" & St & "),1/COUNTIF(" & St & "," & St & ")))")
End Function

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.

 

[hiker95]

SandsB,

Be back soon to update the macro to adjust the dates in the output area.

 

[hiker95]

SandsB,

After the updated macro:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K
1	Date	starting volume	ending volume	refill volume	other stuff		Date	lowest starting volume on this Date	highest ending volume on this Date	highest refill volume on this Date	lowest refill volume on this Date
2	1/1/14	412	422	418	other stuff		1/1/14	54	422	912	28
3	1/1/14	82	45	912	other stuff		1/20/14	9	222	333	20
4	1/1/14	54	40	28	other stuff
5	1/20/14	9	22	20	other stuff
6	1/20/14	111	222	333	other stuff
7
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below NEW code, and, NEW function
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ReorgData_V2()
' hiker95, 09/03/2014, ME803099
Dim r As Long, lr As Long, lc As Long, luc As Long, nlr As Long, n As Long
Dim o As Variant, j As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, 1).End(xlToRight).Column
luc = Cells(1, Columns.Count).End(xlToLeft).Column
If luc > lc Then
  Columns(lc + 2).Resize(, luc - lc + 1).ClearContents
End If
Cells(1, lc + 2) = "Date"
Cells(1, lc + 3) = "lowest" & vbLf & "starting" & vbLf & "volume" & vbLf & "on this" & vbLf & "Date"
Cells(1, lc + 4) = "highest" & vbLf & "ending" & vbLf & "volume" & vbLf & "on this" & vbLf & "Date"
Cells(1, lc + 5) = "highest" & vbLf & "refill" & vbLf & "volume" & vbLf & "on this" & vbLf & "Date"
Cells(1, lc + 6) = "lowest" & vbLf & "refill" & vbLf & "volume" & vbLf & "on this" & vbLf & "Date"
With Range(Cells(1, lc + 2), Cells(1, lc + 6))
  .HorizontalAlignment = xlCenter
  .Columns.AutoFit
End With
Rows(1).AutoFit
nlr = CountUniqueV2(Range("A2:A" & lr))
ReDim o(1 To nlr, 1 To 5)
For r = 2 To lr
  n = Application.CountIf(Columns(1), Cells(r, 1).Value)
  j = j + 1
  o(j, 1) = Cells(r, 1)
  o(j, 2) = WorksheetFunction.Min(Range("B" & r & ":B" & r + n - 1))
  o(j, 3) = WorksheetFunction.Max(Range("C" & r & ":C" & r + n - 1))
  o(j, 4) = WorksheetFunction.Max(Range("D" & r & ":D" & r + n - 1))
  o(j, 5) = WorksheetFunction.Min(Range("D" & r & ":D" & r + n - 1))
  r = r + n - 1
Next r
Cells(2, lc + 2).Resize(UBound(o, 1), UBound(o, 2)) = o
Range(Cells(2, lc + 2), Cells(2 + n, lc + 2)).NumberFormat = "m/d/yy"
Columns(lc + 2).Resize(, luc - lc + 2).AutoFit
Application.ScreenUpdating = False
End Sub
Function CountUniqueV2(ByVal Rng As Range) As Long
' Juan Pablo González, MrExcel MVP, 05/09/2003
' http://www.mrexcel.com/forum/excel-questions/48385-need-count-unique-items-column-visual-basic-applications.html
Dim St As String
Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
St = "'" & Rng.Parent.Name & "'!" & Rng.Address(False, False)
CountUniqueV2 = Evaluate("SUM(IF(LEN(" & St & "),1/COUNTIF(" & St & "," & St & ")))")
End Function

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData_V2 macro.

 

[SandsB]

Sweet!
Thank you, thank you, thank you

 

[hiker95]

SandsB,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.