PDA

View Full Version : [SOLVED] Summarize Data to New Sheet



James Niven
05-14-2017, 01:57 PM
Hi All,

I am looking for a VBA solution here to my raw data tab.
Please refer to my attached spreadsheet for details.

Basically, the "RawData" tab is how I receive the information. On the "Final Output" tab is how I want the data summarized by each driver for that one day.

Can some please help out with some vba code I can run daily to collate this information as I have to enter this summarized data into another spreadsheet for each driver, the number of rows can be several hundred each day.19176

Thanks in advance!!

Bob Phillips
05-14-2017, 02:40 PM
This is easily done in Power Query. Form your data as a table, and use this script


let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
#"Removed Columns" = Table.RemoveColumns(Source,{"DLDATE", "DLROUT", "DLVEHL", "DLCARV", "DLCDPT", "DLWO#", "Container", "Action", "CSADR3", "ADDRESS", "DISPOSAL", "CSUSER", "Pk or Del?"}),
#"Grouped Rows" = Table.Group(#"Removed Columns", {"DNAME", "Zone"}, {{"Count", each Table.RowCount(_), type number}}),
#"Sorted Rows" = Table.Sort(#"Grouped Rows",{{"DNAME", Order.Ascending}, {"Zone", Order.Ascending}}),
#"Pivoted Column" = Table.Pivot(#"Sorted Rows", List.Distinct(#"Sorted Rows"[Zone]), "Zone", "Count", List.Sum)
in
#"Pivoted Column""

James Niven
05-14-2017, 03:04 PM
xld,

Thanks for your reply and the use of Power Query for a solution to my excel spreadsheet.
I have not used Power Query at all, so I do not know where to begin using this.
I would prefer a VBA solution though to my problem.

rlv
05-14-2017, 03:53 PM
Btw, you have needed columns

"EY1"
"RELO1"
"Yd Box"

On the output sheet, but none of those strings appear in your raw data.

James Niven
05-14-2017, 04:03 PM
rtv,

Thanks for the reply, yes there are about 43 possible Zones, but not all of them are used everyday, so, I just want to summarize what is used at one time.

Bob Phillips
05-15-2017, 01:37 AM
I would prefer a VBA solution though to my problem.

You should learn PQ, it is very flexible, very powerful. MS are constantly improving and enhancing it, something that will never again happen for VBA.

The solution I gave handles as many zones as you have, no changes required as that data flexes.

Bob Phillips
05-15-2017, 01:37 AM
I would prefer a VBA solution though to my problem.

You should learn PQ, it is very flexible, very powerful. MS are cionstantly improving and enhancing it, something that will never again happen for VBA.

The solution I gave handles as manyzones as you have, no changes required as that data flexes.

James Niven
05-15-2017, 12:45 PM
Thanks xld!
Yes, I know I should take the time to learn PQ. Can you point me in the direction of a good tutorial?
But, in the mean time I am still looking for a VBA solution for this spreadsheet?

Thanks

Bob Phillips
05-16-2017, 01:29 AM
I hate to do it, the VBA is more complex, less robust, and generally worse, but here goes


Public Sub SummarizeData()
Dim ws As Worksheet
Dim firstrow As Long
Dim lastrow As Long
Dim lastcol As Long
Dim numrows As Long

Set ws = Worksheets.Add

With Worksheets("RawData")

firstrow = .Range("A1").End(xlDown).Row
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
numrows = lastrow - firstrow + 1

'get unique list of drivers
.Cells(firstrow, "C").Resize(numrows).Copy ws.Range("A1")
ws.Range(ws.Range("A1"), ws.Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
ws.Columns("A:A").EntireColumn.AutoFit

'get unique list of Zone
.Cells(firstrow, "N").Resize(numrows).Copy ws.Range("B1")
ws.Range(ws.Range("B1"), ws.Cells(ws.Rows.Count, "B").End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo

'get unique list of Pk or Del?
.Cells(firstrow, "O").Resize(numrows).Copy ws.Range("C1")
ws.Range(ws.Range("C1"), ws.Cells(ws.Rows.Count, "C").End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo
End With

With ws

'merge Zone and Pk or Del? lists and setup as headings
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
numrows = .Cells(.Rows.Count, "C").End(xlUp).Row - 1
.Range(.Range("C2"), .Cells(.Rows.Count, "C").End(xlUp)).Cut Destination:=.Cells(lastrow, "B").Resize(numrows)
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
.Range("B2").Resize(lastrow - 1).Copy
.Range("B1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.Range("B2").Resize(lastrow - 1).ClearContents

'setup formula to count instances
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range("B2").Resize(lastrow - 1, lastcol - 1).FormulaR1C1 = "=COUNTIFS(RawData!C3,RC1,RawData!C14,R1C)+COUNTIFS(RawData!C3,RC1,RawData!C 15,R1C)"
End With
End Sub

James Niven
05-16-2017, 11:52 AM
xld,

I have had a chance today to review the vba solution you have for me, firstly, thanks for going the extra mile, this is fantastic and your code works as requested.
Can you update the code to not show the zeros if that driver does not have an A zone for instant, I just would like to see the count of zones only?

Also, for my education, below, on where it says "Copy ws.Range("B1")", on my sheet is a vlookup formula, how can I change this code to paste special values? I know the demo did not have this, it is straight values.



'get unique list of Zone
.Cells(firstrow, "N").Resize(numrows).Copy ws.Range("B1")
ws.Range(ws.Range("B1"), ws.Cells(ws.Rows.Count, "B").End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo



Thanks again for your patience!!

mdmackillop
05-17-2017, 03:39 AM
A small change after the Formula line.

'setup formula to count instances
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
With .Range("B2").Resize(lastrow - 1, lastcol - 1)
.FormulaR1C1 = "=COUNTIFS(RawData!C3,RC1,RawData!C14,R1C)+COUNTIFS(RawData!C3,RC1,RawData!C 15,R1C)"
.Value = .Value
.NumberFormat = "0;-0;"
End With

Bob Phillips
05-17-2017, 04:54 AM
Nothing wrong with Malcolm's addition, but I noticed a few other things I didn't like in the final layout; there was a blank column; fonts varied; and the columns were not ordered. This version addresses all of those


Public Sub SummarizeData()
Dim ws As Worksheet
Dim firstrow As Long
Dim lastrow As Long
Dim lastcol As Long
Dim numrows As Long
Dim i As Long

Application.ScreenUpdating = False

Set ws = Worksheets.Add

With Worksheets("RawData")

firstrow = .Range("A1").End(xlDown).Row
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
numrows = lastrow - firstrow + 1

'get unique list of drivers
.Cells(firstrow, "C").Resize(numrows).Copy ws.Range("A1")
ws.Range(ws.Range("A1"), ws.Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo

'get unique list of Zone
.Cells(firstrow, "N").Resize(numrows).Copy ws.Range("B1")
ws.Range(ws.Range("B1"), ws.Cells(ws.Rows.Count, "B").End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo

'get unique list of Pk or Del?
.Cells(firstrow, "O").Resize(numrows).Copy ws.Range("C1")
ws.Range(ws.Range("C1"), ws.Cells(ws.Rows.Count, "C").End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo
End With

With ws

'merge Zone and Pk or Del? lists and setup as headings
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
numrows = .Cells(.Rows.Count, "C").End(xlUp).Row - 1
.Range(.Range("C2"), .Cells(.Rows.Count, "C").End(xlUp)).Cut Destination:=.Cells(lastrow, "B").Resize(numrows)
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
.Range("B2").Resize(lastrow - 1).Copy
.Range("B1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
.Range("B2").Resize(lastrow - 1).ClearContents

'setup formula to count instances
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
With .Range("A1").Resize(lastrow, lastcol)

With .Font

.Name = "Calibri"
.Size = 11
End With
End With

With .Range("B2").Resize(lastrow - 1, lastcol - 1)

.FormulaR1C1 = "=COUNTIFS(RawData!C3,RC1,RawData!C14,R1C)+COUNTIFS(RawData!C3,RC1,RawData!C 15,R1C)"
.Value = .Value
.NumberFormat = "General;;"
End With
.Columns("A:A").EntireColumn.AutoFit

'sort columns and remove blanks
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("B1").Resize(, lastcol - 1), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
With .Sort

.SetRange ws.Range("B1").Resize(lastrow - 1, lastcol - 1)
.Header = xlGuess
.MatchCase = False
.Orientation = xlLeftToRight
.SortMethod = xlPinYin
.Apply
End With

For i = lastcol To 2 Step -1

If .Cells(1, i).Value = "" Then

.Columns(i).Delete
Else

Exit For
End If
Next i
End With

Application.ScreenUpdating = True
End Sub

James Niven
05-17-2017, 10:58 AM
mdmackillop,

Thanks for your variation to xld's code, this works like a charm, very much appreciated.

James Niven
05-17-2017, 11:13 AM
xld,

Also, thanks for the additional enhancements to the code, I did see these items you mentioned above and thanks for addressing them.

So, I have been testing the modified code on the my real data and seems to be giving the correct results mostly, it is missing some zones.
I copied and paste special values columns N and O and ran the code and the missing zones are displayed.
I think the issue I am seeing is some of the zones are not being displayed on the new sheet due to the vlookup formula I have which I use to drop in the correct zone under column N based on the grid reference under column M.
I use this spreadsheet every day so, I need to leave in the vlookup formula.

How can I paste special values where it says "Get Unique list of zones"? I know the demo did not have a formula, it had straight values.

Also, when I run the code there is "Type Mismatch" at this line near the bottom of the code. If I comment these lines out the code runs fine.



If .Cells(1, i).Value = "" Then


Thanks again for your assistance!

Bob Phillips
05-17-2017, 11:50 AM
Post an example that shows this discrepancy.

James Niven
05-17-2017, 12:13 PM
xld,

Thanks, here is the real data spreadsheet, I have desensitized the data as much as possible, but it still works.

I have also noted one other issue between my last post and now. If you look at driver BROD1 and ACAN1, they both had E2 zones, they do not display on the new sheet, I think when you copy the data from column C, it pastes on top of E2 before the zones are transposed to columns.

Thanks

James Niven
05-18-2017, 03:52 PM
Bump

rlv
05-19-2017, 08:18 AM
My attempt

James Niven
05-19-2017, 01:05 PM
Hi rlv,

Thanks for your contribution to my task, this works very well and I see your approach.
I am learning VBA slowly and I have learnt a lot from xld and how he tackled my task.

One thing I did notice was on the "Results" sheet, the drivers are in alphabetically order, can we set this to the order they appear on the pivot sheet. The reason for this, I transfer the results data to another spreadsheet and that spreadsheet is in the order as the pivot data.

Thanks and I appreciate your offer to assist me.

rlv
05-19-2017, 03:17 PM
If you stick with VBA, one thing that will become clear is that there is almost always more than one way to accomplish a given task, and you can learn a lot from comparing different approaches. I've been using VBA for a good while now and I'm at the point where I can more or less code anything I want to do without outside input. But that leads to always solving certain problems in certain ways, so for me, the value of a site like this is to see how other people code things which gets me out of my comfort zone and tying new things.

Per the driver order, you can comment out the first sort statement and the order should then match the pivot sheet.

James Niven
05-19-2017, 03:36 PM
Thanks rlv, I was playing around myself about an hour ago and via stepping through the code I found this line and commented it out and I got the results I wanted.
I appreciate your input and options!!