How to generate quintile values

S

spanishnick

New Member
Joined
Nov 10, 2021
Messages
12
Platform
  1. Windows
Hi,

I'd like to split my data (column AS) into quintile groups, i.e. assign a value from 1 (lowest 20%) to 5 (highest 20%) in column AT. I've written the code below but get the following error message: "Sub of Function not defined", referring to dataout in row 14 (the first propvalue(r, 1).Value ). I was wondering if anyone could give me a hand.

Thank you!

VBA Code: 
Sub quintiles()


With Sheets("Geomapping Data")
.Range("au1:au102835") = ""
datout = .Range("au1:au102835") ' load all the data into a variant array


propvalue = .Range("as1:as102835")

For r = 2 To 102835

If propvalue(r, 1).Value <= WorksheetFunction.Percentile("AS:AS", 0.2) Then
    dataout(r, 1).Value = 1
Else
If propvalue(r, 1).Value > WorksheetFunction.Percentile("AS:AS", 0.2) And propvalue(r, 1).Value <= WorksheetFunction.Percentile("AS:AS", 0.4) Then
    dataout(r, 1).Value = 2
Else
If propvalue(r, 1).Value > WorksheetFunction.Percentile("AS:AS", 0.4) And propvalue(r, 1).Value <= WorksheetFunction.Percentile("AS:AS", 0.6) Then
    dataout(r, 1).Value = 3
Else
If propvalue(r, 1).Value > WorksheetFunction.Percentile("AS:AS", 0.6) And propvalue(r, 1).Value <= WorksheetFunction.Percentile("AS:AS", 0.8) Then
    dataout(r, 1).Value = 4
Else
If propvalue(r, 1).Value > WorksheetFunction.Percentile("AS:AS", 0.8) And propvalue(r, 1).Value <= WorksheetFunction.Percentile("AS:AS", 1) Then
    dataout(r, 1).Value = 5
End If
End If
End If
End If
End If

Next r

End With

End Sub
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
the syntax is wrong:
propvalue and dataout are both variant array because you loaded them from the worksheet, so you don't need the ".value" because they only contain values. when refering to a range, you need to specify ".value" because ranges are complicated object that have lots of parameters e.g. value. value2. address. row, column etc
So change
VBA Code: 
If propvalue(r, 1).Value <= WorksheetFunction.Percentile("AS:AS", 0.2) Then
    dataout(r, 1).Value = 1
Else
If propvalue(r, 1).Value > WorksheetFunction.Percentile("AS:AS", 0.2) And propvalue(r, 1).Value <= WorksheetFunction.Percentile("AS:AS", 0.4) Then
    dataout(r, 1).Value = 2
Else
If propvalue(r, 1).Value > WorksheetFunction.Percentile("AS:AS", 0.4) And propvalue(r, 1).Value <= WorksheetFunction.Percentile("AS:AS", 0.6) Then
    dataout(r, 1).Value = 3
Else
If propvalue(r, 1).Value > WorksheetFunction.Percentile("AS:AS", 0.6) And propvalue(r, 1).Value <= WorksheetFunction.Percentile("AS:AS", 0.8) Then
    dataout(r, 1).Value = 4
Else
If propvalue(r, 1).Value > WorksheetFunction.Percentile("AS:AS", 0.8) And propvalue(r, 1).Value <= WorksheetFunction.Percentile("AS:AS", 1) Then
    dataout(r, 1).Value = 5
End If
to
VBA Code: 
If propvalue(r, 1) <= WorksheetFunction.Percentile("AS:AS", 0.2) Then
    dataout(r, 1) = 1
Else
If propvalue(r, 1) > WorksheetFunction.Percentile("AS:AS", 0.2) And propvalue(r, 1) <= WorksheetFunction.Percentile("AS:AS", 0.4) Then
    dataout(r, 1) = 2
Else
If propvalue(r, 1) > WorksheetFunction.Percentile("AS:AS", 0.4) And propvalue(r, 1) <= WorksheetFunction.Percentile("AS:AS", 0.6) Then
    dataout(r, 1) = 3
Else
If propvalue(r, 1) > WorksheetFunction.Percentile("AS:AS", 0.6) And propvalue(r, 1) <= WorksheetFunction.Percentile("AS:AS", 0.8) Then
    dataout(r, 1) = 4
Else
If propvalue(r, 1) > WorksheetFunction.Percentile("AS:AS", 0.8) And propvalue(r, 1) <= WorksheetFunction.Percentile("AS:AS", 1) Then
    dataout(r, 1) = 5
End If
 
Last edited:
Upvote 0
you can speed up your code by taking all of the references to the worksheet out of the loop like this:
VBA Code: 
point2 = WorksheetFunction.Percentile("AS:AS", 0.2)
point4 = WorksheetFunction.Percentile("AS:AS", 0.4)
point6 = WorksheetFunction.Percentile("AS:AS", 0.6)
point8 = WorksheetFunction.Percentile("AS:AS", 0.8)
point10 = WorksheetFunction.Percentile("AS:AS", 0.8)

For r = 2 To 102835


If propvalue(r, 1) <= point2 Then
    dataout(r, 1) = 1
Else
If propvalue(r, 1) > point2 And propvalue(r, 1) <= point4 Then
    dataout(r, 1) = 2
Else
If propvalue(r, 1) > point4 And propvalue(r, 1) <= point6 Then
    dataout(r, 1) = 3
Else
If propvalue(r, 1) > point6 And propvalue(r, 1) <= point8 Then
    dataout(r, 1) = 4
Else
If propvalue(r, 1) > point8 And propvalue(r, 1) <= point10 Then
    dataout(r, 1) = 5
End If
 
Last edited:
Upvote 0
Hi @offthelip,

Thank you for your help and the detailed explanation. I've made the suggested changes. However, I get a new error message using the code below, i.e. "Unable to get the Percentile property of the WorksheetFunction class". I also changed the point2/4/6/8/10 to equal WorksheetFunction.Percentile("AS2:AS102835", 0.2) to exclude the first row (i.e. title) but no luck unfortunately. :/

VBA Code: 
Sub quintiles()


With Sheets("Geomapping Data")
.Range("au1:au102835") = ""
dataout = .Range("au1:au102835") ' load all the data into a variant array
propvalue = .Range("as1:as102835")


point2 = WorksheetFunction.Percentile("AS:AS", 0.2)
point4 = WorksheetFunction.Percentile("AS:AS", 0.4)
point6 = WorksheetFunction.Percentile("AS:AS", 0.6)
point8 = WorksheetFunction.Percentile("AS:AS", 0.8)
point10 = WorksheetFunction.Percentile("AS:AS", 1)

For r = 2 To 102835


If propvalue(r, 1) <= point2 Then
    dataout(r, 1) = 1
Else
If propvalue(r, 1) > point2 And propvalue(r, 1) <= point4 Then
    dataout(r, 1) = 2
Else
If propvalue(r, 1) > point4 And propvalue(r, 1) <= point6 Then
    dataout(r, 1) = 3
Else
If propvalue(r, 1) > point6 And propvalue(r, 1) <= point8 Then
    dataout(r, 1) = 4
Else
If propvalue(r, 1) > point8 And propvalue(r, 1) <= point10 Then
    dataout(r, 1) = 5
End If

Next r

End With

End Sub
 
Last edited:
Upvote 0
PHP: 
Sub test()
Rng = Range("au1:au20")
dataout = Range("as1:as20")
With WorksheetFunction
For i = 1 To UBound(Rng)
    If Rng(i, 1) <= .Percentile(Rng, 0.2) Then
    dataout(i, 1) = 1
    Else
        If Rng(i, 1) <= .Percentile(Rng, 0.4) Then
        dataout(i, 1) = 2
            Else
            If Rng(i, 1) <= .Percentile(Rng, 0.6) Then
            dataout(i, 1) = 3
                Else
                If Rng(i, 1) <= .Percentile(Rng, 0.8) Then
                dataout(i, 1) = 4
                    Else
                    dataout(i, 1) = 5
                End If
            End If
        End If
    End If
Next
End With
Range("as1:as20").Value = dataout
End Sub
 
Upvote 0
Thank you @bebo021999, I've use a slightly modified code following your suggestion and it works well with a range of up to 20 observations.

Code: 
Sub quintiles()
Rng = Range("as1:as20")
dataout = Range("au1:au20")
With Sheets("Geomapping Data")

For i = 2 To UBound(Rng)
    If Rng(i, 1) <= WorksheetFunction.Percentile(Rng, 0.2) Then
    dataout(i, 1) = 1
    Else
        If Rng(i, 1) <= WorksheetFunction.Percentile(Rng, 0.4) Then
        dataout(i, 1) = 2
            Else
            If Rng(i, 1) <= WorksheetFunction.Percentile(Rng, 0.6) Then
            dataout(i, 1) = 3
                Else
                If Rng(i, 1) <= WorksheetFunction.Percentile(Rng, 0.8) Then
                dataout(i, 1) = 4
                    Else
                    dataout(i, 1) = 5
                End If
            End If
        End If
    End If
Next
End With
Range("au1:au20").Value = dataout
End Sub

However, my data contains more than 100'000 rows and takes a few minutes (with an unresponsive Excel unfortunately). Therefore, I've attempted to define points as per @offthelip 's recommendations but no data is exporting (see below)

VBA Code: 
Sub quintiles()
Rng = Range("as1:as102835")
dataout = Range("au1:au102835")
With Sheets("Geomapping Data")


point2 = WorksheetFunction.Percentile(Rng, 0.2)
point4 = WorksheetFunction.Percentile(Rng, 0.4)
point6 = WorksheetFunction.Percentile(Rng, 0.6)
point8 = WorksheetFunction.Percentile(Rng, 0.8)
point10 = WorksheetFunction.Percentile(Rng, 1)

For i = 2 To UBound(Rng)
    If Rng(i, 1) <= point2 Then
    dataout(i, 1) = 1
    Else
        If Rng(i, 1) <= point4 Then
        dataout(i, 1) = 2
            Else
            If Rng(i, 1) <= point6 Then
            dataout(i, 1) = 3
                Else
                If Rng(i, 1) <= point8 Then
                dataout(i, 1) = 4
                    Else
                    dataout(i, 1) = 5
                End If
            End If
        End If
    End If
Next
End With
Range("au1:au102835").Value = dataout
End Sub
 
Upvote 0
Hi @bebo021999,

I've updated the code and it now works perfectly (see below). However, when call it in a master, it does not work (only when I run it separately) and get the error message "Unable to get the Percentile property of the WorksheetFunction class". Unsure what could be the issue.

Master file:
Code: 
Sub master()
ts1 = Timer()
Call geocode
Call datacode
Call quintiles

ts2 = Timer()
MsgBox 1000 * (ts2 - ts1) & "milliseconds"
End Sub

VBA Code: 
Sub quintiles()
Rng = Range("as1:as102835")
dataout = Range("at1:at102835")
With Sheets("Geomapping Data")


point2 = WorksheetFunction.Percentile(Rng, 0.2)
point4 = WorksheetFunction.Percentile(Rng, 0.4)
point6 = WorksheetFunction.Percentile(Rng, 0.6)
point8 = WorksheetFunction.Percentile(Rng, 0.8)
point10 = WorksheetFunction.Percentile(Rng, 1)

For i = 2 To UBound(Rng)
    If Rng(i, 1) <= point2 Then
    dataout(i, 1) = 1
    Else
        If Rng(i, 1) <= point4 Then
        dataout(i, 1) = 2
            Else
            If Rng(i, 1) <= point6 Then
            dataout(i, 1) = 3
                Else
                If Rng(i, 1) <= point8 Then
                dataout(i, 1) = 4
                    Else
                    dataout(i, 1) = 5
                End If
            End If
        End If
    End If
Next
End With
Range("at1:at102835").Value = dataout

' Table of differences
Worksheets("Baseline Weights").Range("n9") = Application.WorksheetFunction.SumIf(Sheets("Geomapping Data").Columns("AT:AT"), 1, Sheets("Geomapping Data").Columns("AS:AS"))
Worksheets("Baseline Weights").Range("n10") = Application.WorksheetFunction.SumIf(Sheets("Geomapping Data").Columns("AT:AT"), 2, Sheets("Geomapping Data").Columns("AS:AS"))
Worksheets("Baseline Weights").Range("n11") = Application.WorksheetFunction.SumIf(Sheets("Geomapping Data").Columns("AT:AT"), 3, Sheets("Geomapping Data").Columns("AS:AS"))
Worksheets("Baseline Weights").Range("n12") = Application.WorksheetFunction.SumIf(Sheets("Geomapping Data").Columns("AT:AT"), 4, Sheets("Geomapping Data").Columns("AS:AS"))
Worksheets("Baseline Weights").Range("n13") = Application.WorksheetFunction.SumIf(Sheets("Geomapping Data").Columns("AT:AT"), 5, Sheets("Geomapping Data").Columns("AS:AS"))

End Sub
 
Upvote 0
I think you have probably got the wrong ranges in your calculation:
these two statement pick up the values from the active sheet.
VBA Code: 
Rng = Range("as1:as102835")
dataout = Range("at1:at102835")
after this you have the statement
VBA Code: 
With Sheets("Geomapping Data")
But none of the range references after this statement will reference the geomapping data sheet because they are all refernce the active sheet. So I suspect the DATACODE sub routnine leaves the active not where you want it. The best way round this is to make all the reference using the with construct. so assuming you want all the ranges from the geomapping sheet, I would do it like this:
VBA Code: 
With Sheets("Geomapping Data")

Rng = .Range(.Cells(1, 45), .Cells(102835, 45))
dataout = .Range(.Cells(1, 46), .Cells(102835, 46))

 '''' your code in here
.Range(.Cells(1, 46), .Cells(102835, 46)).Value = dataout
End With
 
Upvote 0
Or:
point2 = WorksheetFunction.Percentile(Rng, 0.2)

to become:
point2 = Application.WorksheetFunction.Percentile(Rng, 0.2)

???
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Multiple columns into 2?
Replies
6
Views
99
Georgiboy
Georgiboy
P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
328
pure vito
P
M
  • Solved
Replacing delete with a value
Replies
3
Views
165
Alex Blakenburg
A
F
  • Question
How to multiply two arrays together
Replies
1
Views
126
FlashDota
F
I
  • Question
Listbox not being populate when code is run
Replies
4
Views
291
ipbr21054
I

Forum statistics

Threads
1,215,051
Messages
6,122,872
Members
449,097
Latest member
dbomb1414

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