View Single Post
 
Old 11-24-2023, 07:34 PM
gmaxey gmaxey is offline Windows 10 Office 2019
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,439
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Code:
Private Sub cmdSort_Click()
Dim lngIndex As Long, lngLblCount As Long
Dim j As Long
Dim oColLbls As New Collection
  ReDim arrCaps(0)
  For Each oCtrl In Controls
    'Filter for specific type
    If TypeName(oCtrl) = "Label" Then
      'Add to collection and index label counter
      oColLbls.Add oCtrl
      lngLblCount = lngLblCount + 1
      If oCtrl.Caption <> "" Then
        'Dimension, add to array and index counter
        ReDim Preserve arrCaps(lngIndex)
        arrCaps(lngIndex) = Trim(oCtrl.Caption)
        lngIndex = lngIndex + 1
      End If
     End If
  Next oCtrl
  For lngIndex = LBound(arrCaps) To UBound(arrCaps) - 1
    For j = lngIndex + 1 To UBound(arrCaps)
      If frmMultiClickWrite.optAscending.Value = True Then
        If arrCaps(lngIndex) > arrCaps(j) Then '>' for ascending
          Temp = arrCaps(j)
          arrCaps(j) = arrCaps(lngIndex)
          arrCaps(lngIndex) = Temp
        End If
      End If
      If frmMultiClickWrite.optDescending.Value = True Then
        If arrCaps(lngIndex) < arrCaps(j) Then '<' for descending
          Temp = arrCaps(j)
          arrCaps(j) = arrCaps(lngIndex)
          arrCaps(lngIndex) = Temp
        End If
      End If
    Next j
  Next lngIndex
  'Clear captions
  For lngIndex = 1 To lngLblCount
    oColLbls(lngIndex).Caption = vbNullString
  Next lngIndex
  'Add sorted captions
  For lngIndex = 0 To UBound(arrCaps)
    oColLbls(lngIndex + 1).Caption = arrCaps(lngIndex)
  Next lngIndex
lbl_Exit:
  Exit Sub
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote