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
If percentileArray(1) > 0 Then
Set group1 = dataSheet.Range("N1").Resize(1, percentileArray(1))
Else
Please help me
Full code
VBA 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
