VBA - Top 10 percent of each region

Question

I have an Excel 2013 spreadsheet that, among other things, shows the Income for assets in different Districts.

I'm writing a macro that will enter a date in an empty cell next to the income IF that income is in the top 10 percent for that District and not recently reviewed. And that's where I'm finding difficulty.

I can write a line of code to return the top ten percent of income, but can't figure out how to return the top ten percent of one District.

As a function, I can achieve the desired result as follows: {=LARGE(IF(I13:I1000=800,IF(AO13:AO1000<>DATE(2015,3,12),AI13:AI1000,""),""), 17)}

For my macro, I have written code that will:

1) Accept input for which district will be reviewed and the date of review

2) Determine when the last review was conducted (kind of, same problem, I need to find the max for assets that are in a certain district)

3) Calculate how many assets need to be reviewed (top ten percent and bottom twenty percent)

This is the code that I have so far:

Sub ScheduleNextReview()
'Determine which district will be reviewed
    Dim Dist As String
    Dim NextDate As Date

    Dist = InputBox(Prompt:="Enter district for review:", Title:="Dist:", Default:="000")
    NextDate = InputBox(Prompt:="Date of Review", Title:="Enter Date for next review:", Default:="mm/dd/yyyy")

'Find date of Last Review
    Dim rng As Range
    Dim LastReview As Date
    Set rng = ActiveSheet.Range("AL13:AL1000")
    LastReview = Application.WorksheetFunction.Max(rng) 'need to figure out how to get the max value for those in Dist

'Count number of wells in district and find top ten percent and bottom twenty percent
    Dim DistTtl As Double
    Dim TopTenth As Integer
    Dim BottomTwent As Integer

    DistTtl = WorksheetFunction.CountIf(Range("I13:I10000"), Dist)
    TopTenth = WorksheetFunction.Round(DistTtl / 10, 0)
    BottomTwent = WorksheetFunction.Round(DistTtl / 5, 0)

MsgBox "There are " & TopTenth & " assets in the top ten percent, and " & BottomTwent & " assets in the bottom twenty percent of " & Dist & " for review on " & NextDate & "."
End Sub

I'm struggling to figure out how to define a range with an IF statement or get the worksheetfunction equivalent of the function I pasted above.

Please let me know if anything requires further clarification Thanks!

Yes, you need to create that: So add some code to this question as indicated in the manuals regarding use of stackoverflow. — Norbert, Jul 11 '15 at 04:29
You should include what you have tried (`code`) To improve your chances of getting an answer - [here are some tips](http://stackoverflow.com/help/how-to-ask) — 0m3r, Jul 11 '15 at 05:18
Thanks for the feedback. I have edited my question to include the work I have accomplished. I apologize if something is unclear or unconventional; I am brand new to coding and began with VBA/macros a couple weeks ago because there is nobody else in my company who can do it and Excel allows me to record macros and teach myself as much as possible (i.e. I'm in way over my head). — elt2jdavis, Jul 13 '15 at 20:12
I could not come up with a way to make this work strictly with VBA so I added a function to a hidden sheet and used those values in my macro. — elt2jdavis, Jul 21 '15 at 13:52

elt2jdavis · Accepted Answer · 2015-08-12T21:05:26.613

The best work around I could come up with was to use a function like: {=PERCENTILE.INC(IF(I13:I999=100,AI13:AI999,""), 0.9)}

I did this function for each district and then created a series of ElseIf statements to get the 90th percentile for the chosen district:

            Dim Dist90 As Double
            Dim Dist As Integer

        If Dist = 100 Then
            Dist90 = Cells(2, 48)
        ElseIf Dist = 200 Then Dist90 = Cells(3, 48)
        ElseIf Dist = 300 Then Dist90 = Cells(4, 48)
        ElseIf Dist = 400 Then Dist90 = Cells(5, 48)
        ElseIf Dist = 500 Then Dist90 = Cells(6, 48)
        ElseIf Dist = 600 Then Dist90 = Cells(7, 48)
        ElseIf Dist = 700 Then Dist90 = Cells(8, 48)
        ElseIf Dist = 800 Then Dist90 = Cells(9, 48)
        End If

VBA - Top 10 percent of each region

1 Answers1