0
votes

Hi All Excel/VBA experts,

Need your help on making a macro that counts the average count of a city from a column. Right below I have a macro that can count the number of a city from the given array. Need to put the average count of the city next to the name. Thank you for the help.

Public Sub CountA()

Dim wb As Workbook
Dim ws As Worksheet
Dim lastCell As String
Dim countRange As Range

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet 'Change as appropriate

Set countRange = ws.Range(Cells(2, "V"), Cells(ws.Range("V2").End(xlDown).Row, "V"))

Debug.Print countRange.Address

Dim Cities()
Cities = Array("Auckland", "Brisbane", "Melbourne", "Seoul", "Tokyo", "Sydney", "Bratislava", "Bangalore", "Chennai", "Gurgaon", "Hyderabad", "Kolkata", "New Delhi", "Noida", "Mumbai", "London", "Munich", "Unterfohring", "Aachen", "Abidjan", "Abington", "Alpharetta", "Amstelveen", "Amsterdam", "Anaheim", "Aquascalientes", "Arlon", "Ashland", "Atlanta", "Aurora", "Austin", "Barcelona", "Basel", "Batavia", "Bay Village", "Belton", "Berkshire", "Berlin", "Birmingham", "Bogota", "Boise", "Boston", "Bramley", "Brandon", "Brecksville", "Brentwood", "Bridgetown", "Brussels", "Budapest", "Buffalo Grove", "Bury", "Cairo", "Callahan", "Calumet City", "Cape Town", "Capitola", "Cardiff", "Carmel", "Centennial", "Chanhassen", "Charlotte", "Cheltenham", "Cincinnati", "Clearwater", "Clemson", "Cleveland", "Cohoes", "Columbia", "Columbus", "Conifer", "Cookeville", "Copenhagen", "Coral Gables", "Croydon", "Culver City", "Cumming", "Cutchogue", "Dallas", "Dallas Park", "Darmstadt", "Double Oak", "Dublin")

Dim city As Long
Dim counter As Long
Dim startRange As Range
Set startRange = ws.Cells(ws.Range("V2").End(xlDown).Row, "V").Offset(2, 0)

counter = 2

For city = LBound(Cities) To UBound(Cities)
    Debug.Print Cities(x)
  If Application.WorksheetFunction.CountIf(countRange, Cities(city)) > 0 Then
    startRange.Offset(counter, 0) = Application.WorksheetFunction.CountIf(countRange, Cities(city))
    startRange.Offset(counter, 1) = Cities(city)
     counter = counter + 1

  End If

Next city


End Sub

Tried this:

For city = LBound(Cities) To UBound(Cities) 
    Debug.Print Cities(x) 
    If Application.WorksheetFunction.AverageIf(countRange, Cities(city)) > 0 Then 
        startRange.Offset(counter, 0) = Application.WorksheetFunction.AverageIf(countRange, Cities(city)) 
        startRange.Offset(counter, 1) = Cities(city)

Currently my code can CountIf the City highlighted in BLUE and shows the result below it highlighted in RED and Highlighted in Yellow. My objective is to add another data which is the percentage of the city highlighted in Green. I can do that manually by doing fo rexample =COUNTIF(V2:V25,"Bratislava")/COUNTA(V2:V5) . But as you could see on my arrays I need to type everything manually per city. Thank you for the expert help.

enter image description here

2
Seems like you know you need to use AVERAGEIF() here - did you try that? It's quite similar to your existing code...Tim Williams
I did change countif to averageif but giving me the run time error 1004: Unable to get the averageif property if the worksheefFunction class.Jonathan
It's usually best to post the code that's failing, and include the error messageTim Williams
For city = LBound(Cities) To UBound(Cities) Debug.Print Cities(x) If Application.WorksheetFunction.AverageIf(countRange, Cities(city)) > 0 Then startRange.Offset(counter, 0) = Application.WorksheetFunction.AverageIf(countRange, Cities(city)) startRange.Offset(counter, 1) = Cities(city) This is the code that is failing(highlighted in yellow). The error message is: Run time error 1004. Unable to get the averageif property if the worksheefFunction class.Jonathan
Did you notice that AverageIf takes one more argument than Countif? You need to tell it where to take the average from. So for example Application.WorksheetFunction.AverageIf(countRange, Cities(city), countRange.Offset(0,1)) if the values you want to average are in the column to the right of the City names.Tim Williams

2 Answers

1
votes

You need to add a couple of lines.

Get the total number of cities:

Dim citiesCount As Long
citiesCount = countRange.Rows.Count

Write out the proportion of the total number of cities of each city:

startRange.Offset(counter, -1) = Application.WorksheetFunction.CountIf(countRange, Cities(city)) / citiesCount

I would highly recommend you use Tim's suggestion of reading in the cities from a worksheet rather than typing them all in.

I would also recommend error handling in case nothing is present in column V.

With the additional lines you get:

Option Explicit

Public Sub CountA()

Dim wb As Workbook
Dim ws As Worksheet
Dim lastCell As String
Dim countRange As Range

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet 'Change as appropriate

Set countRange = ws.Range(Cells(2, "V"), Cells(ws.Range("V2").End(xlDown).Row, "V"))

Dim Cities()
Cities = Array("Auckland", "Brisbane", "Melbourne", "Seoul", "Tokyo", "Sydney", "Bratislava", "Bangalore", "Chennai", "Gurgaon", "Hyderabad", "Kolkata", "New Delhi", "Noida", "Mumbai", "London", "Munich", "Unterfohring", "Aachen", "Abidjan", "Abington", "Alpharetta", "Amstelveen", "Amsterdam", "Anaheim", "Aquascalientes", "Arlon", "Ashland", "Atlanta", "Aurora", "Austin", "Barcelona", "Basel", "Batavia", "Bay Village", "Belton", "Berkshire", "Berlin", "Birmingham", "Bogota", "Boise", "Boston", "Bramley", "Brandon", "Brecksville", "Brentwood", "Bridgetown", "Brussels", "Budapest", "Buffalo Grove", "Bury", "Cairo", "Callahan", "Calumet City", "Cape Town", "Capitola", "Cardiff", "Carmel", "Centennial", "Chanhassen", "Charlotte", "Cheltenham", "Cincinnati", "Clearwater", "Clemson", "Cleveland", "Cohoes", "Columbia", "Columbus", "Conifer", "Cookeville", "Copenhagen", "Coral Gables", "Croydon", "Culver City", "Cumming", "Cutchogue", "Dallas", "Dallas Park", "Darmstadt", "Double Oak", "Dublin")

Dim city As Long
Dim counter As Long
Dim startRange As Range

Set startRange = ws.Cells(ws.Range("V2").End(xlDown).Row, "V").Offset(2, 0)

counter = 2

Dim citiesCount As Long
citiesCount = countRange.Rows.Count 'new line to hold total number of cities

For city = LBound(Cities) To UBound(Cities)

  If Application.WorksheetFunction.CountIf(countRange, Cities(city)) > 0 Then
    startRange.Offset(counter, -1) = Application.WorksheetFunction.CountIf(countRange, Cities(city)) / citiesCount 'new line to calculate proportion of total
    startRange.Offset(counter, 0) = Application.WorksheetFunction.CountIf(countRange, Cities(city))
    startRange.Offset(counter, 1) = Cities(city)
     counter = counter + 1

  End If

Next city

End Sub

Here is a version 2 reading the list of cities from a worksheet called CitiesList, ensuring you are in right sheets and some error handling for empty count range.

Option Explicit

Public Sub CountA()

    Dim wb As Workbook
    Dim ws As Worksheet
  ' Dim lastCell As String ''not used
    Dim countRange As Range

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")             'Change as appropriate

    Set countRange = ws.Range(ws.Cells(2, "V"), ws.Cells(ws.Range("V2").End(xlDown).Row, "V"))

    Dim Cities()
    Cities = GetCities                           'Call function to populate array with cities from worksheet

    Dim city As Long
    Dim counter As Long
    Dim startRange As Range

    On Error Resume Next 'Error handling for range being empty. Might not be the best error handling.
    Set startRange = ws.Cells(ws.Range("V2").End(xlDown).Row, "V").Offset(2, 0)
    On Error GoTo 0

    If startRange Is Nothing Then
       Exit Sub
    Else
       Resume
    End If

    counter = 2

    Dim citiesCount As Long
    citiesCount = countRange.Rows.Count

    With ws                                      'make sure in right sheet

        For city = LBound(Cities, 1) To UBound(Cities, 1)

            If Application.WorksheetFunction.CountIf(countRange, Cities(city, 1)) > 0 Then
                startRange.Offset(counter, -1) = Application.WorksheetFunction.CountIf(countRange, Cities(city, 1)) / citiesCount
                startRange.Offset(counter, 0) = Application.WorksheetFunction.CountIf(countRange, Cities(city, 1))
                startRange.Offset(counter, 1) = Cities(city, 1)
                counter = counter + 1

            End If

        Next city

    End With

End Sub

Public Function GetCities() As Variant
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets("CitiesList")
    GetCities = ws.Range("B2", ws.Range("B2").End(xlDown)) ' Amend as appropriate

End Function
0
votes

Compiled but not tested:

Public Sub CountA()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lastCell As String
    Dim countRange As Range

    Set wb = ThisWorkbook
    Set ws = wb.ActiveSheet 'Change as appropriate

    Set countRange = ws.Range(Cells(2, "V"), Cells(ws.Range("V2").End(xlDown).Row, "V"))

    Debug.Print countRange.Address

    Dim Cities()
    '<TW> you should really load these from a worksheet....
    Cities = Array("Auckland", "Brisbane", "Melbourne", "Seoul", "Tokyo", "Sydney", _
                    "Bratislava", "Bangalore", "Chennai", "Gurgaon", "Hyderabad")

    Dim city As Long
    Dim counter As Long
    Dim startRange As Range
    Dim r As Variant
    Set startRange = ws.Cells(ws.Range("V2").End(xlDown).Row, "V").Offset(2, 0)

    counter = 2

    For city = LBound(Cities) To UBound(Cities)

        Debug.Print Cities(city)

        'assuming the values to be averaged are in the column to the right of the city names
        '   adjust as required...
        r = Application.AverageIf(countRange, Cities(city), countRange.Offset(0, 1))

        startRange.Offset(counter, 0).Resize(1, 2).Value = Array(r, Cities(city))
        counter = counter + 1

     Next city

End Sub