Home » excel » excel – VBA to cycle through a column getting the ranges for the first 10 (Or max if less than 10) for each location

excel – VBA to cycle through a column getting the ranges for the first 10 (Or max if less than 10) for each location

Posted by: admin May 14, 2020 Leave a comment

Questions:

I am basically trying to grab the ranges for the top ten rows of each location, if there are less than ten then it would use the max ranges

For example with the data below if it is put in column A, then the first range would be A2:A11 the second range would be A14:A16 and the third would be A17:A26

Location
London
London
London
London
London
London
London
London
London
London
London
London
Liverpool
Liverpool
Liverpool
York
York
York
York
York
York
York
York
York
York
York
York
York
York
York

I’m trying to incorporate it so that I can make multiple pie charts all at once using the following:

Charts.Add2
ActiveChart.SetSourceData Source:=Range("'MainSheet'!$T$3:$T$14")
ActiveChart.ChartType = xlPie
ActiveChart.SetElement (msoElementLegendRight)
ActiveChart.FullSeriesCollection(1).XValues = "='MainSheet'!$I$4:$I$14"
Sheets("MainSheet").Select

Download link for example excel file: https://mega.co.nz/#!PhgWTB7a!Ie0HzaA66-vsR8nDpsQzsSlLZ9A4egoDzNtuWNR8uhU

Alternative Download link: https://www.dropbox.com/s/f44be4vj2b82lx1/Example_Pies.xlsx

I have no idea how to do this so I would much appreciate the help.

How to&Answers:

MASSIVE EDIT:

As per uploaded file, here is a working code. Optimization is up to you. TRIED AND TESTED AND WORKING.

Sub CreateCharts()

    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
    Dim Val1 As Range, Val2 As Range, Val3 As Range
    Dim RngNames As Range

    Set RngNames = Sheets("MainSheet").Range("C4:C60")

    Set Rng1 = Range(GetTopRange(RngNames, "London", 10)).Offset(0, 6)
    Set Rng2 = Range(GetTopRange(RngNames, "Newcastle", 10)).Offset(0, 6)
    Set Rng3 = Range(GetTopRange(RngNames, "York", 10)).Offset(0, 6)

    Set Val1 = Rng1.Offset(0, 11)
    Set Val2 = Rng2.Offset(0, 11)
    Set Val3 = Rng3.Offset(0, 11)

    AddChart Rng1, Val1, "London"
    AddChart Rng2, Val2, "Newcastle"
    AddChart Rng3, Val3, "York"

End Sub

Sub AddChart(rLabel As Range, rValues As Range, sTitle As String)
    Dim Cht As Chart
    Set Cht = Charts.Add
    With Cht
        .Name = sTitle
        .ChartType = xlPie
        .SetSourceData Source:=Union(rLabel, rValues)
        '.HasTitle = True
        .ChartTitle.Characters.Text = sTitle
    End With
End Sub

Function GetTopRange(Rng As Range, StrLine As String, NumCount As Long) As String
    Application.Volatile
    Dim Cell As Range, URng As Range
    For Each Cell In Rng.SpecialCells(xlCellTypeConstants)
        If Cell.Value = StrLine Then
            If URng Is Nothing Then
                Set URng = Cell
            Else
                Set URng = Union(URng, Cell)
            End If
            If URng.Cells.Count = NumCount Then
                Exit For
            End If
        End If
    Next Cell
    GetTopRange = URng.Address
End Function

Thanks.

Answer:

My 2c:

Function TopRange(DataRange As Range, v)
Dim f As Range
    Set f = DataRange.Find(v, , xlValues, xlWhole)
    If Not f Is Nothing Then
        TopRange = f.Resize(Application.Min( _
             Application.CountIf(DataRange, v), 10)).Address()
    Else
        TopRange = "not found"
    End If
End Function