Automate a Market Share Analysis

K

KimberlyHeart

New Member
Joined
Mar 17, 2016
Messages
19
I have a large data file with vehicle makes and the states in which they were registered. Using VBA, I am trying to create a quick button (script) which will produce, on separate sheet, the "market share" of each make, per state. I know a Pivot Table will get me counts per make per state, but I am trying to produce this using VBA. The data originally looks like this every month:

Code: 
[TABLE="width: 960"]
<tbody>[TR]
[TD]Reg St[/TD]
[TD]Reg County[/TD]
[TD]Registration Address[/TD]
[TD]Reg City[/TD]
[TD]Reg Zip[/TD]
[TD]Make[/TD]
[TD]Year Model[/TD]
[TD]Rpt Yr[/TD]
[TD]Rpt Mo[/TD]
[/TR]
[TR]
[TD]AK[/TD]
[TD]ANCHORAGE[/TD]
[TD]4200 W 50TH AVE[/TD]
[TD]ANCHORAGE[/TD]
[TD]99502[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2016[/TD]
[TD]2015[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]AK[/TD]
[TD]FAIRBANKS N STAR[/TD]
[TD]3311 LATHROP ST[/TD]
[TD]FAIRBANKS[/TD]
[TD]99701[/TD]
[TD]KIA[/TD]
[TD]2016[/TD]
[TD]2015[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]AK[/TD]
[TD]FAIRBANKS N STAR[/TD]
[TD]360 E VAN HORN RD[/TD]
[TD]FAIRBANKS[/TD]
[TD]99701[/TD]
[TD]TOYOTA[/TD]
[TD]2016[/TD]
[TD]2015[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]AK[/TD]
[TD]FAIRBANKS N STAR[/TD]
[TD]360 E VAN HORN RD[/TD]
[TD]FAIRBANKS[/TD]
[TD]99701[/TD]
[TD]TOYOTA[/TD]
[TD]2016[/TD]
[TD]2015[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]AK[/TD]
[TD]NORTH SLOPE[/TD]
[TD]340012 POUCH[/TD]
[TD]PRUDHOE BAY[/TD]
[TD]99734[/TD]
[TD]TOYOTA[/TD]
[TD]2016[/TD]
[TD]2015[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]AK[/TD]
[TD]NORTH SLOPE[/TD]
[TD]340012 POUCH[/TD]
[TD]PRUDHOE BAY[/TD]
[TD]99734[/TD]
[TD]TOYOTA[/TD]
[TD]2016[/TD]
[TD]2015[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]CHEVROLET[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]CHEVROLET[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]CHEVROLET[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]CHEVROLET[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]CHEVROLET[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]CHEVROLET[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]CHEVROLET[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]CHEVROLET[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]CHEVROLET[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]CHEVROLET[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]BIBB[/TD]
[TD]35 PINEVIEW DR[/TD]
[TD]WEST BLOCTON[/TD]
[TD]35184[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]BIBB[/TD]
[TD]35 PINEVIEW DR[/TD]
[TD]WEST BLOCTON[/TD]
[TD]35184[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2015[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]LOWNDES[/TD]
[TD]POB 397[/TD]
[TD]FORT DEPOSIT[/TD]
[TD]36032[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2015[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2015[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2015[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]SHELBY[/TD]
[TD]7051 MEADOWLARK DR[/TD]
[TD]BIRMINGHAM[/TD]
[TD]35242[/TD]
[TD]FORD MOTOR CO[/TD]
[TD]2015[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]CULLMAN[/TD]
[TD]40 COUNTY ROAD 517[/TD]
[TD]HANCEVILLE[/TD]
[TD]35077[/TD]
[TD]NISSAN[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]CULLMAN[/TD]
[TD]40 COUNTY ROAD 517[/TD]
[TD]HANCEVILLE[/TD]
[TD]35077[/TD]
[TD]NISSAN[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]CULLMAN[/TD]
[TD]40 COUNTY ROAD 517[/TD]
[TD]HANCEVILLE[/TD]
[TD]35077[/TD]
[TD]NISSAN[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]CULLMAN[/TD]
[TD]40 COUNTY ROAD 517[/TD]
[TD]HANCEVILLE[/TD]
[TD]35077[/TD]
[TD]NISSAN[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]CULLMAN[/TD]
[TD]40 COUNTY ROAD 517[/TD]
[TD]HANCEVILLE[/TD]
[TD]35077[/TD]
[TD]NISSAN[/TD]
[TD]2016[/TD]
[TD]2016[/TD]
[TD]01[/TD]
[/TR]
</tbody>[/TABLE]

And, I am trying to get it into this format:

Code: 
[TABLE="width: 273"]
<tbody>[TR]
[TD]Reg St[/TD]
[TD]Make[/TD]
[TD="align: center"]CNT[/TD]
[TD="align: center"]%[/TD]
[/TR]
[TR]
[TD]AK[/TD]
[TD]FORD MOTOR CO[/TD]
[TD="align: center"]1[/TD]
[TD="align: center"]17%[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]KIA[/TD]
[TD="align: center"]2[/TD]
[TD="align: center"]17%[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]TOYOTA[/TD]
[TD="align: center"]4[/TD]
[TD="align: center"]67%[/TD]
[/TR]
[TR]
[TD]AL[/TD]
[TD]CHEVROLET[/TD]
[TD="align: center"]10[/TD]
[TD="align: center"]29%[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]FORD MOTOR CO[/TD]
[TD="align: center"]13[/TD]
[TD="align: center"]38%[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]NISSAN[/TD]
[TD="align: center"]5[/TD]
[TD="align: center"]15%
[/TD]
[/TR]
</tbody>[/TABLE]


Sometimes the States have no data, and the list of Makes for each state varies to more than what is even shown here. I'm thinking it may involve arrays, but I'm not that familiar with them in VBA. Does anyone have a quick script which can help me get to this result?
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
Started to write something, but then I thought, why not just set up a table like your desired results, and just use the COUNTIFS function?
 
Upvote 0
Thanks for the reply svendiamond!

Like I mentioned in my OP, I'm trying to get this entire process set up on an ActiveX button, so I can load the new data into a worksheet and then press the button and have the new sheet display the desired results.
I could also do this in a few steps with a Pivot Table, but I'm trying to simplify this even further by using the VBA code. More work up front, but easier in the long run.

Thanks for the idea!
 
Upvote 0
Alright. Try this, you might change the "Sheet1" and "Sheet2" to go along with your actual sheet names:

Rich (BB code): 
Sub getData()

Dim lastRow As Long, myLoop As Long, myState As String, myCar As String, nextBlank As Long
Dim ws1 As Worksheet, ws2 As Worksheet, rangeStates As Range, rangeCars As Range

Set ws1 = Sheets("Sheet1")  'this is the sheet with the raw data
Set ws2 = Sheets("Sheet2")  'this is the output sheet

Set rangeStates = ws2.Range("A:A")
Set rangeCars = ws2.Range("B:B")

With ws1
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For myLoop = 2 To lastRow
        nextBlank = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
        myState = .Cells(myLoop, 1).Value
        myCar = .Cells(myLoop, 6).Value
        If WorksheetFunction.CountIfs(rangeStates, myState, rangeCars, myCar) = 0 Then
            ws2.Cells(nextBlank, 1).Value = myState
            ws2.Cells(nextBlank, 2).Value = myCar
        End If
    Next myLoop
End With

With ws2
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("C2").Value = "=COUNTIFS(" & ws1.Name & "!A:A,A2," & ws1.Name & "!F:F,B2)"
    .Range("D2").Value = "=C2/SUMIF(A:A,A2,C:C)"
    .Range("C2:D" & lastRow).FillDown
End With

End Sub
 
Last edited:
Upvote 0
Thank you svendiamond! :)

This is what I ended up with for final code:

Code: 
Sub getData()

Dim lastRow As Long, myLoop As Long, myState As String, myCar As String, nextBlank As Long
Dim ws1 As Worksheet, ws2 As Worksheet, rangeStates As Range, rangeCars As Range
Dim ms, msold, num As Integer

' Add a new sheet for the new data
    num = 1
    For ms = 1 To Worksheets.Count
        If Worksheets(ms).Name = "MarketShare" Then
            found = True
        End If
    Next
    If found = True Then
        For msold = 1 To Worksheets.Count
            If Worksheets(msold).Name Like "*MarketShare*" Then
             num = num + 1
            End If
        Next
        Sheets("MarketShare").Name = "MarketShare-Old" & num
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = "MarketShare"
    Else
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = "MarketShare"
    End If

Set ws1 = Sheets("Vehicles")  'this is the sheet with the raw data
Set ws2 = Sheets("MarketShare")  'this is the output sheet

ws1.Select
lastRow = Range("A" & ws1.Rows.Count).End(xlUp).Row
ws1.Range("A2:N" & lastRow).Sort Key1:=ws1.Range("A1"), Key2:=ws1.Range("B1"), Key3:=ws1.Range("C1")


Set rangeStates = ws2.Range("A:A")
Set rangeCars = ws2.Range("B:B")

With ws1
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    For myLoop = 2 To lastRow
        nextBlank = ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
        myState = .Cells(myLoop, 1).Value
        myCar = .Cells(myLoop, 6).Value
        If WorksheetFunction.CountIfs(rangeStates, myState, rangeCars, myCar) = 0 Then
            ws2.Cells(nextBlank, 1).Value = myState
            ws2.Cells(nextBlank, 2).Value = myCar
        End If
    Next myLoop
End With

With ws2
    lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("C2").Value = "=COUNTIFS(" & ws1.Name & "!A:A,A2," & ws1.Name & "!F:F,B2)"
    .Range("D2").Value = "=C2/SUMIF(A:A,A2,C:C)"
    .Range("C2:D" & lastRow).FillDown
End With

End Sub

And it works perfectly.
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,215,949
Messages
6,127,888
Members
449,411
Latest member
AppellatePerson

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top