VB6Parse / Library / Graphics / partition

VB6 Library Reference

Partition Function

Returns a String indicating where a number occurs within a calculated series of ranges.

Syntax

Partition(number, start, stop, interval)

Parameters

Return Value

Returns a String describing the range in which number falls. The format is: - "lowerbound:upperbound" for ranges within the series - " :lowerbound-1" for values less than start - "upperbound+1: " for values greater than stop

Remarks

The Partition function divides a range of numbers into smaller intervals and returns a string describing which interval contains a given number. This is particularly useful for creating frequency distributions, histograms, and grouping data into bins.

The function creates ranges starting at start and ending at stop, with each range having a width of interval. The returned string always has the same width for both the lower and upper boundaries, padded with leading spaces as needed. This ensures consistent formatting when building reports or tables.

For example, if start is 0, stop is 100, and interval is 10, the function creates ranges: 0:9, 10:19, 20:29, etc., plus special ranges for values below 0 (":–1") and above 100 ("101:").

The width of each number in the returned string is calculated based on the number of digits in stop plus 1. This ensures all ranges align properly in columnar displays.

Typical Uses

  1. Frequency Distribution: Creating frequency tables for statistical analysis
  2. Histogram Generation: Grouping data into bins for histogram charts
  3. Age Group Analysis: Categorizing people into age brackets (0-9, 10-19, etc.)
  4. Sales Range Reports: Grouping sales figures into ranges for analysis
  5. Performance Banding: Categorizing test scores or metrics into performance bands
  6. Data Binning: Organizing continuous data into discrete categories
  7. Time Period Grouping: Grouping timestamps into hour, day, or week ranges
  8. Price Range Analysis: Categorizing products by price ranges

Basic Examples

Example 1: Simple Partition

Dim range As String
range = Partition(15, 0, 100, 10)    ' Returns " 10: 19"
range = Partition(5, 0, 100, 10)     ' Returns "  0:  9"
range = Partition(95, 0, 100, 10)    ' Returns " 90: 99"

Example 2: Frequency Distribution

' Count how many values fall in each range
Dim values(100) As Integer
Dim frequency As Collection
Dim i As Integer
Dim range As String

Set frequency = New Collection

' Populate with sample data
For i = 0 To 100
values(i) = Int(Rnd * 100)
Next i

' Count frequencies
For i = 0 To 100
range = Partition(values(i), 0, 99, 10)
' Increment count for this range
Next i

Example 3: Age Grouping

Function GetAgeGroup(age As Integer) As String
' Group ages into decades
GetAgeGroup = Partition(age, 0, 100, 10)
End Function

' Usage
Debug.Print GetAgeGroup(25)    ' Returns " 20: 29"
Debug.Print GetAgeGroup(5)     ' Returns "  0:  9"

Example 4: Out of Range Values

Dim range As String
range = Partition(-5, 0, 100, 10)    ' Returns "   : -1" (below start)
range = Partition(150, 0, 100, 10)   ' Returns "101:   " (above stop)

Common Patterns

Pattern 1: BuildFrequencyTable

Function BuildFrequencyTable(values() As Integer, start As Long, _
stop As Long, interval As Long) As Collection
Dim i As Integer
Dim range As String
Dim count As Long
Dim freq As Collection

Set freq = New Collection

' Initialize all ranges to 0
For i = start To stop Step interval
range = Partition(i, start, stop, interval)
On Error Resume Next
freq.Add 0, range
On Error GoTo 0
Next i

' Count occurrences
For i = LBound(values) To UBound(values)
range = Partition(values(i), start, stop, interval)
On Error Resume Next
count = freq(range)
freq.Remove range
freq.Add count + 1, range
On Error GoTo 0
Next i

Set BuildFrequencyTable = freq
End Function

Pattern 2: GenerateHistogram

Sub GenerateHistogram(values() As Integer, start As Long, _
stop As Long, interval As Long)
Dim i As Integer
Dim range As String
Dim counts As Object
Dim currentRange As String

Set counts = CreateObject("Scripting.Dictionary")

' Count frequencies
For i = LBound(values) To UBound(values)
range = Partition(values(i), start, stop, interval)
If Not counts.Exists(range) Then
counts.Add range, 0
End If
counts(range) = counts(range) + 1
Next i

' Display histogram
Debug.Print "Range", "Count", "Chart"
Debug.Print String(50, "-")
For Each currentRange In counts.Keys
Debug.Print currentRange, counts(currentRange), _
String(counts(currentRange), "*")
Next currentRange
End Sub

Pattern 3: ClassifyValue

Function ClassifyValue(value As Long, start As Long, _
stop As Long, interval As Long) As String
Dim range As String
range = Partition(value, start, stop, interval)

If InStr(range, ":") = 1 Then
ClassifyValue = "Below Range"
ElseIf Right(range, 1) = ":" Then
ClassifyValue = "Above Range"
Else
ClassifyValue = "In Range: " & Trim(range)
End If
End Function

Pattern 4: GetRangeBoundaries

Sub GetRangeBoundaries(partitionStr As String, _
ByRef lower As Long, ByRef upper As Long)
Dim parts() As String
parts = Split(partitionStr, ":")

If UBound(parts) = 1 Then
On Error Resume Next
lower = CLng(Trim(parts(0)))
upper = CLng(Trim(parts(1)))
On Error GoTo 0
End If
End Sub
' Usage: GetRangeBoundaries(" 20: 29", lower, upper)  ' lower=20, upper=29

Pattern 5: AnalyzeDataDistribution

Function AnalyzeDataDistribution(data() As Variant) As String
Dim minVal As Long, maxVal As Long
Dim i As Long
Dim report As String
Dim range As String
Dim counts As Object

' Find min and max
minVal = data(LBound(data))
maxVal = data(LBound(data))
For i = LBound(data) + 1 To UBound(data)
If data(i) < minVal Then minVal = data(i)
If data(i) > maxVal Then maxVal = data(i)
Next i

' Build frequency table
Set counts = CreateObject("Scripting.Dictionary")
For i = LBound(data) To UBound(data)
range = Partition(data(i), minVal, maxVal, (maxVal - minVal) \ 10)
If Not counts.Exists(range) Then counts.Add range, 0
counts(range) = counts(range) + 1
Next i

' Build report
report = "Data Distribution:" & vbCrLf
For Each range In counts.Keys
report = report & range & ": " & counts(range) & vbCrLf
Next range

AnalyzeDataDistribution = report
End Function

Pattern 6: ValidatePartitionParameters

Function ValidatePartitionParameters(start As Long, stop As Long, _
interval As Long) As Boolean
ValidatePartitionParameters = False

If start < 0 Then
MsgBox "Start must be >= 0"
Exit Function
End If

If stop <= start Then
MsgBox "Stop must be > start"
Exit Function
End If

If interval < 1 Then
MsgBox "Interval must be >= 1"
Exit Function
End If

ValidatePartitionParameters = True
End Function

Pattern 7: CreateRangeLabels

Function CreateRangeLabels(start As Long, stop As Long, _
interval As Long) As String()
Dim labels() As String
Dim count As Long
Dim i As Long
Dim index As Long

count = (stop - start) \ interval + 3  ' +3 for below, above, and safety
ReDim labels(0 To count)

index = 0
For i = start To stop Step interval
labels(index) = Partition(i, start, stop, interval)
index = index + 1
Next i

ReDim Preserve labels(0 To index - 1)
CreateRangeLabels = labels
End Function

Pattern 8: CountInRange

Function CountInRange(values() As Variant, targetRange As String, _
start As Long, stop As Long, interval As Long) As Long
Dim i As Long
Dim count As Long

count = 0
For i = LBound(values) To UBound(values)
If Partition(values(i), start, stop, interval) = targetRange Then
count = count + 1
End If
Next i

CountInRange = count
End Function

Pattern 9: GetRangeMidpoint

Function GetRangeMidpoint(partitionStr As String) As Double
Dim lower As Long, upper As Long
Dim parts() As String

parts = Split(partitionStr, ":")
If UBound(parts) = 1 Then
On Error Resume Next
lower = CLng(Trim(parts(0)))
upper = CLng(Trim(parts(1)))
If Err.Number = 0 Then
GetRangeMidpoint = (lower + upper) / 2
End If
On Error GoTo 0
End If
End Function

Pattern 10: GroupByRange

Function GroupByRange(values() As Variant, start As Long, _
stop As Long, interval As Long) As Object
Dim groups As Object
Dim i As Long
Dim range As String
Dim groupItems As Collection

Set groups = CreateObject("Scripting.Dictionary")

For i = LBound(values) To UBound(values)
range = Partition(values(i), start, stop, interval)

If Not groups.Exists(range) Then
Set groupItems = New Collection
groups.Add range, groupItems
End If

groups(range).Add values(i)
Next i

Set GroupByRange = groups
End Function

Advanced Usage

Example 1: Statistical Analysis Tool

' Comprehensive statistical analysis using Partition
Class StatisticalAnalyzer
Private m_data() As Double
Private m_binCount As Long
Private m_minValue As Double
Private m_maxValue As Double

Public Sub LoadData(data() As Double)
Dim i As Long
ReDim m_data(LBound(data) To UBound(data))

m_minValue = data(LBound(data))
m_maxValue = data(LBound(data))

For i = LBound(data) To UBound(data)
m_data(i) = data(i)
If data(i) < m_minValue Then m_minValue = data(i)
If data(i) > m_maxValue Then m_maxValue = data(i)
Next i
End Sub

Public Property Let BinCount(value As Long)
If value > 0 Then m_binCount = value
End Property

Public Function GetFrequencyDistribution() As Object
Dim freq As Object
Dim i As Long
Dim interval As Long
Dim range As String
Dim start As Long, stop As Long

Set freq = CreateObject("Scripting.Dictionary")

start = Int(m_minValue)
stop = Int(m_maxValue)
interval = (stop - start) \ m_binCount
If interval < 1 Then interval = 1

For i = LBound(m_data) To UBound(m_data)
range = Partition(Int(m_data(i)), start, stop, interval)
If Not freq.Exists(range) Then
freq.Add range, 0
End If
freq(range) = freq(range) + 1
Next i

Set GetFrequencyDistribution = freq
End Function

Public Function GetHistogramData() As Object
Dim histogram As Object
Dim freq As Object
Dim range As Variant
Dim item As Object

Set freq = GetFrequencyDistribution()
Set histogram = CreateObject("Scripting.Dictionary")

For Each range In freq.Keys
Set item = CreateObject("Scripting.Dictionary")
item.Add "Range", range
item.Add "Count", freq(range)
item.Add "Percentage", (freq(range) / UBound(m_data)) * 100
histogram.Add range, item
Next range

Set GetHistogramData = histogram
End Function

Public Function GenerateReport() As String
Dim report As String
Dim histogram As Object
Dim range As Variant
Dim maxCount As Long
Dim barWidth As Long

Set histogram = GetHistogramData()

' Find max count for scaling
maxCount = 0
For Each range In histogram.Keys
If histogram(range)("Count") > maxCount Then
maxCount = histogram(range)("Count")
End If
Next range

report = "Frequency Distribution Report" & vbCrLf
report = report & String(60, "=") & vbCrLf
report = report & "Data Points: " & UBound(m_data) + 1 & vbCrLf
report = report & "Min Value: " & m_minValue & vbCrLf
report = report & "Max Value: " & m_maxValue & vbCrLf
report = report & String(60, "-") & vbCrLf
report = report & "Range          Count    Pct    Chart" & vbCrLf
report = report & String(60, "-") & vbCrLf

For Each range In histogram.Keys
barWidth = Int((histogram(range)("Count") / maxCount) * 30)
report = report & range & "  " & _
Format(histogram(range)("Count"), "0000") & "  " & _
Format(histogram(range)("Percentage"), "00.0") & "%  " & _
String(barWidth, "#") & vbCrLf
Next range

GenerateReport = report
End Function

Public Function GetModeRange() As String
' Find the range with the highest frequency
Dim freq As Object
Dim range As Variant
Dim maxCount As Long
Dim modeRange As String

Set freq = GetFrequencyDistribution()
maxCount = 0

For Each range In freq.Keys
If freq(range) > maxCount Then
maxCount = freq(range)
modeRange = range
End If
Next range

GetModeRange = modeRange
End Function
End Class

Example 2: Sales Performance Analyzer

' Analyze sales performance by grouping into performance bands
Module SalesAnalyzer
Private Type SalesRecord
SalesPerson As String
Amount As Currency
Date As Date
End Type

Public Function AnalyzeSalesPerformance(sales() As SalesRecord) As String
Dim i As Long
Dim minSale As Currency, maxSale As Currency
Dim interval As Currency
Dim performanceBands As Object
Dim range As String
Dim report As String
Dim totalSales As Long

' Find range
minSale = sales(LBound(sales)).Amount
maxSale = sales(LBound(sales)).Amount
For i = LBound(sales) To UBound(sales)
If sales(i).Amount < minSale Then minSale = sales(i).Amount
If sales(i).Amount > maxSale Then maxSale = sales(i).Amount
Next i

' Create 5 performance bands
interval = Int((maxSale - minSale) / 5)
If interval < 1 Then interval = 1

Set performanceBands = CreateObject("Scripting.Dictionary")

' Categorize sales
totalSales = UBound(sales) - LBound(sales) + 1
For i = LBound(sales) To UBound(sales)
range = Partition(Int(sales(i).Amount), Int(minSale), _
Int(maxSale), interval)
If Not performanceBands.Exists(range) Then
performanceBands.Add range, 0
End If
performanceBands(range) = performanceBands(range) + 1
Next i

' Generate report
report = "Sales Performance Analysis" & vbCrLf
report = report & String(50, "=") & vbCrLf
report = report & "Total Sales: " & totalSales & vbCrLf
report = report & "Range: $" & Format(minSale, "#,##0") & _
" - $" & Format(maxSale, "#,##0") & vbCrLf
report = report & String(50, "-") & vbCrLf

For Each range In performanceBands.Keys
report = report & "Range " & range & ": " & _
performanceBands(range) & " sales (" & _
Format((performanceBands(range) / totalSales) * 100, "0.0") & _
"%)" & vbCrLf
Next range

AnalyzeSalesPerformance = report
End Function

Public Function GetPerformanceLevel(amount As Currency, _
minAmount As Currency, _
maxAmount As Currency) As String
Dim range As String
Dim interval As Currency

interval = (maxAmount - minAmount) / 5
range = Partition(Int(amount), Int(minAmount), Int(maxAmount), Int(interval))

' Convert to performance labels
Dim parts() As String
Dim lowerBound As Long
parts = Split(range, ":")

On Error Resume Next
lowerBound = CLng(Trim(parts(0)))
On Error GoTo 0

If lowerBound <= minAmount + interval Then
GetPerformanceLevel = "Needs Improvement"
ElseIf lowerBound <= minAmount + interval * 2 Then
GetPerformanceLevel = "Below Average"
ElseIf lowerBound <= minAmount + interval * 3 Then
GetPerformanceLevel = "Average"
ElseIf lowerBound <= minAmount + interval * 4 Then
GetPerformanceLevel = "Above Average"
Else
GetPerformanceLevel = "Excellent"
End If
End Function
End Module

Example 3: Age Demographics Tool

' Tool for analyzing age demographics with Partition
Class AgeDemographicsAnalyzer
Private m_ages() As Integer
Private m_ageGroupSize As Integer

Public Sub Initialize(ages() As Integer, groupSize As Integer)
Dim i As Long
ReDim m_ages(LBound(ages) To UBound(ages))
For i = LBound(ages) To UBound(ages)
m_ages(i) = ages(i)
Next i
m_ageGroupSize = groupSize
End Sub

Public Function GetAgeDistribution() As Object
Dim dist As Object
Dim i As Long
Dim range As String

Set dist = CreateObject("Scripting.Dictionary")

For i = LBound(m_ages) To UBound(m_ages)
range = Partition(m_ages(i), 0, 120, m_ageGroupSize)
If Not dist.Exists(range) Then
dist.Add range, 0
End If
dist(range) = dist(range) + 1
Next i

Set GetAgeDistribution = dist
End Function

Public Function GetAgeGroupName(age As Integer) As String
Dim range As String
range = Partition(age, 0, 120, m_ageGroupSize)

Select Case m_ageGroupSize
Case 10
' Decades
If InStr(range, " 0:") > 0 Then
GetAgeGroupName = "Children (0-9)"
ElseIf InStr(range, "10:") > 0 Then
GetAgeGroupName = "Teens (10-19)"
ElseIf InStr(range, "20:") > 0 Then
GetAgeGroupName = "Twenties (20-29)"
ElseIf InStr(range, "30:") > 0 Then
GetAgeGroupName = "Thirties (30-39)"
ElseIf InStr(range, "40:") > 0 Then
GetAgeGroupName = "Forties (40-49)"
ElseIf InStr(range, "50:") > 0 Then
GetAgeGroupName = "Fifties (50-59)"
ElseIf InStr(range, "60:") > 0 Then
GetAgeGroupName = "Sixties (60-69)"
Else
GetAgeGroupName = "70+"
End If
Case Else
GetAgeGroupName = Trim(range)
End Select
End Function

Public Function GenerateDemographicsReport() As String
Dim report As String
Dim dist As Object
Dim range As Variant
Dim total As Long

Set dist = GetAgeDistribution()
total = UBound(m_ages) - LBound(m_ages) + 1

report = "Age Demographics Report" & vbCrLf
report = report & String(50, "=") & vbCrLf
report = report & "Total Population: " & total & vbCrLf
report = report & "Age Group Size: " & m_ageGroupSize & " years" & vbCrLf
report = report & String(50, "-") & vbCrLf
report = report & "Age Range      Count    Percentage" & vbCrLf
report = report & String(50, "-") & vbCrLf

For Each range In dist.Keys
report = report & range & "  " & _
Format(dist(range), "0000") & "    " & _
Format((dist(range) / total) * 100, "00.0") & "%" & vbCrLf
Next range

GenerateDemographicsReport = report
End Function

Public Function GetMedianAgeRange() As String
' Find the range containing the median age
Dim sortedAges() As Integer
Dim i As Long
Dim medianAge As Integer

' Copy and sort ages
ReDim sortedAges(LBound(m_ages) To UBound(m_ages))
For i = LBound(m_ages) To UBound(m_ages)
sortedAges(i) = m_ages(i)
Next i

' Simple bubble sort (for demonstration)
Dim temp As Integer, j As Long
For i = LBound(sortedAges) To UBound(sortedAges) - 1
For j = i + 1 To UBound(sortedAges)
If sortedAges(i) > sortedAges(j) Then
temp = sortedAges(i)
sortedAges(i) = sortedAges(j)
sortedAges(j) = temp
End If
Next j
Next i

' Get median
medianAge = sortedAges((LBound(sortedAges) + UBound(sortedAges)) \ 2)

GetMedianAgeRange = Partition(medianAge, 0, 120, m_ageGroupSize)
End Function
End Class

Example 4: Test Score Grading System

' Automatic grading system using Partition
Module GradingSystem
Public Function GetLetterGrade(score As Integer) As String
Dim range As String

' Use Partition to determine grade range (0-100, intervals of 10)
range = Partition(score, 0, 100, 10)

' Convert range to letter grade
If score >= 90 Then
GetLetterGrade = "A"
ElseIf score >= 80 Then
GetLetterGrade = "B"
ElseIf score >= 70 Then
GetLetterGrade = "C"
ElseIf score >= 60 Then
GetLetterGrade = "D"
Else
GetLetterGrade = "F"
End If
End Function

Public Function AnalyzeClassScores(scores() As Integer) As String
Dim gradeDistribution As Object
Dim i As Long
Dim range As String
Dim report As String
Dim total As Long

Set gradeDistribution = CreateObject("Scripting.Dictionary")
total = UBound(scores) - LBound(scores) + 1

' Count scores in each range
For i = LBound(scores) To UBound(scores)
range = Partition(scores(i), 0, 100, 10)
If Not gradeDistribution.Exists(range) Then
gradeDistribution.Add range, 0
End If
gradeDistribution(range) = gradeDistribution(range) + 1
Next i

' Build report
report = "Class Score Distribution" & vbCrLf
report = report & String(40, "=") & vbCrLf
report = report & "Total Students: " & total & vbCrLf
report = report & String(40, "-") & vbCrLf

For Each range In gradeDistribution.Keys
report = report & range & ": " & gradeDistribution(range) & _
" (" & Format((gradeDistribution(range) / total) * 100, "0.0") & _
"%)" & vbCrLf
Next range

AnalyzeClassScores = report
End Function

Public Function GetClassStatistics(scores() As Integer) As Object
Dim stats As Object
Dim dist As Object
Dim i As Long
Dim range As String
Dim sum As Long
Dim passingCount As Long

Set stats = CreateObject("Scripting.Dictionary")
Set dist = CreateObject("Scripting.Dictionary")

sum = 0
passingCount = 0

For i = LBound(scores) To UBound(scores)
sum = sum + scores(i)
If scores(i) >= 60 Then passingCount = passingCount + 1

range = Partition(scores(i), 0, 100, 10)
If Not dist.Exists(range) Then dist.Add range, 0
dist(range) = dist(range) + 1
Next i

stats.Add "Average", sum / (UBound(scores) - LBound(scores) + 1)
stats.Add "PassingRate", (passingCount / (UBound(scores) - LBound(scores) + 1)) * 100
stats.Add "Distribution", dist

Set GetClassStatistics = stats
End Function
End Module

Error Handling

The Partition function can raise errors in the following situations:

Always validate parameters before calling Partition:

If start >= 0 And stop > start And interval >= 1 Then
range = Partition(value, start, stop, interval)
Else
MsgBox "Invalid partition parameters"
End If

Performance Considerations

Best Practices

  1. Validate Parameters: Always check that start >= 0, stop > start, and interval >= 1
  2. Choose Appropriate Intervals: Select interval sizes that create meaningful groups
  3. Handle Edge Cases: Account for values below start and above stop
  4. Use Consistent Formatting: Leverage the automatic padding for aligned displays
  5. Parse Results Carefully: Remember the format includes spaces and colons
  6. Consider Alternatives: For simple range checks, If statements may be clearer
  7. Document Ranges: Clearly document the meaning of each partition range
  8. Test Boundaries: Verify behavior at start, stop, and interval boundaries
  9. Cache When Possible: If using same parameters repeatedly, cache the range labels
  10. Combine with Collections: Use Dictionary or Collection for frequency counting
Function Purpose Returns Use Case
Partition Create range labels String (range description) Frequency distributions, histograms
Switch Choose from value pairs Variant (matched value) Simple value mapping
Choose Pick from list by index Variant (indexed item) Select from fixed options
IIf Conditional expression Variant (true/false result) Simple binary choices
Select Case Multi-way branching N/A (statement) Complex conditional logic

Platform and Version Notes

Limitations

← Back to Graphics | View all functions