Help with Calculate the percentiles by VBA

[nhnn1986]

I want to Calculate the percentiles by VBA, code belove wrong thiss line:

If percentileArray(1) > 0 Then
Set group1 = dataSheet.Range("N1").Resize(1, percentileArray(1))
Else

Please help me
Full code

Sub SplitDataByPercentile()

    ' Set the range of data to be split
    Dim dataSheet As Worksheet
    Set dataSheet = ThisWorkbook.Sheets("KHOI_NHTM")
    Dim dataRange As Range
    Set dataRange = dataSheet.Range("N2", dataSheet.Cells(2, dataSheet.Columns.Count).End(xlToLeft))
    
    ' Check if dataRange has enough data
    If dataRange.Columns.Count < 3 Then
        MsgBox "Unable to calculate percentiles. Please check if there is enough data."
        Exit Sub
    End If
    
    ' Calculate the percentiles
    Dim percentileArray As Variant
    percentileArray = Application.Percentile(dataRange, Array(0.33, 0.67))
    
    ' Check if percentileArray has values
    If UBound(percentileArray) < 1 Then
        MsgBox "Unable to calculate percentiles. Please check if there is enough data."
        Exit Sub
    End If
    
    ' Split the data into three groups
    Dim group1 As Range, group2 As Range, group3 As Range
    
    ' Check if percentileArray has values for group1
    If percentileArray(1) > 0 Then
        Set group1 = dataSheet.Range("N1").Resize(1, percentileArray(1))
    Else
        MsgBox "Unable to split data into groups. Please check if there is enough data."
        Exit Sub
    End If
    
    ' Check if percentileArray has values for group2
    If percentileArray(1) >= 0 And percentileArray(2) > percentileArray(1) Then
        Set group2 = dataSheet.Range("N1").Offset(0, percentileArray(1)).Resize(1, percentileArray(2) - percentileArray(1))
    Else
        MsgBox "Unable to split data into groups. Please check if there is enough data."
        Exit Sub
    End If
    
    ' Check if percentileArray has values for group3
    If percentileArray(2) >= percentileArray(1) And percentileArray(2) < dataRange.Columns.Count Then
        Set group3 = dataSheet.Range("N1").Offset(0, percentileArray(2)).Resize(1, dataRange.Columns.Count - percentileArray(2))
    Else
        MsgBox "Unable to split data into groups. Please check if there is enough data."
        Exit Sub
    End If
    
    ' Check if group1 has values
    If group1.Columns.Count = 0 Then
        MsgBox "Unable to split data into groups. Please check if there is enough data."
        Exit Sub
    End If
    
    ' Check if the "Peer_group" sheet exists and delete it if it does
    Dim peerGroupSheet As Worksheet
    On Error Resume Next
    Set peerGroupSheet = ThisWorkbook.Sheets("Peer_group")
    On Error GoTo 0
    If Not peerGroupSheet Is Nothing Then
        Application.DisplayAlerts = False
        peerGroupSheet.Delete
        Application.DisplayAlerts = True
    End If
    
    ' Create a new sheet named "Peer_group"
    Set peerGroupSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    peerGroupSheet.Name = "Peer_group"
    
    ' Check if dataRange has enough data to copy
    If dataRange.Rows.Count < 1 Then
        MsgBox "Unable to copy data to the new sheet. Please check if there is enough data."
        Exit Sub
    End If
    
    ' Copy the data and headers to the new sheet
    dataRange.Copy peerGroupSheet.Range("N2")
    dataSheet.Range("N1", dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft)).Copy peerGroupSheet.Range("N1")
    
    ' Add borders to the groups
    group1.BorderAround xlContinuous, xlMedium
    group2.BorderAround xlContinuous, xlMedium
    group3.BorderAround xlContinuous, xlMedium
    
End Sub

 

[nhnn1986]

By the way, since Application.Percentile(dataRange, Array(0.33, 0.67)) returns a two-element array containing either numbers or error values, If UBound(percentileArray) < 1 Then will always evaluate to False. Try the following instead...

If Application.Count(percentileArray) <> 2 Then

Hope this helps!

Thnaks for your help

 

[Domenic]

You're very welcome, cheers!