Sort the DIM statements on length and alfabet

[Guus2005]

I wanted to sort the dim statements on length as part of my vb_Beautifier code: https://www.access-programmers.co.uk/forums/showthread.php?t=210180
It can't be done they said.
This code fixes a problem that doesn't exist.

It is just a cosmetic fix. It runs some string manipulations on the clipboard.

This is what you do: copy the dim statements into the clipboard.

    Dim intElements As Integer
    Dim intX As Integer
    Dim arr As Variant
    Dim intPrefix As Integer
    Dim intAs As Integer
    Dim intLongeste As Integer

Run this command in the immediate window

DoFixDim


Paste the clipboard

    Dim arr         As Variant
    Dim intX        As Integer
    Dim intAs       As Integer
    Dim intPrefix   As Integer
    Dim intElements As Integer
    Dim intLongeste As Integer

Share & Enjoy!

Option Explicit

Public Sub DoFixDim()
'Run this sub in the immediate window.
'Sort dimensions in clipboard.

    Dim arr         As Variant
    Dim intX        As Integer
    Dim intAs       As Integer
    Dim intPrefix   As Integer
    Dim intLangste  As Integer
    Dim intElements As Integer
    
    arr = ClipToArray() 'From clipboard to array.
    
    intElements = UBound(arr, 1)
    
    'Add variable length, separated by |
    For intX = LBound(arr) To intElements
        If Len(Trim(arr(intX))) > 0 Then
            arr(intX) = Format(Len(Split(Trim(arr(intX)), " ")(1)), "0#") & "|" & Trim(arr(intX)) 'Store length of variable as a prefix
        End If
    Next intX
    
    BubbleSort arr                                    'Sort the array
    intLangste = Int(Split(arr(UBound(arr)), "|")(0)) 'What is the longest variable?
    StripSpaces arr                                   'Remove double spaces using regex

    For intX = LBound(arr) To intElements
        If Len(Trim(arr(intX))) > 0 Then
            intAs = InStr(1, Split(Trim(arr(intX)), "|")(1), " As ")
            If intAs = 0 Then
                'Remove length from string (first element) there is no type
                arr(intX) = Trim(Split(arr(intX), "|")(1))
            Else
                'Remove length from string (first element) add spaces before 'As'
                arr(intX) = vbTab & Trim(Left$(Split(arr(intX), "|")(1), intAs)) & Space(intLangste - Int(Split(Trim(arr(intX)), "|")(0))) & Mid$(Split(Trim(arr(intX)), "|")(1), intAs)
            End If
        End If
    Next intX
    
    'Array to clipboard.
    ArrayToClip arr
    
End Sub

Public Function RegExpReplace(ByVal strWhichString As String, ByVal strPattern As String, ByVal strReplaceWith As String, Optional ByVal IsGlobal As Boolean = True, Optional ByVal IsCaseSensitive As Boolean = True) As String
'Thanks to arnelgp @AWF
    With CreateObject("vbscript.regexp")
        .Global = IsGlobal
        .Pattern = strPattern
        .IgnoreCase = Not IsCaseSensitive
        RegExpReplace = .Replace(strWhichString, strReplaceWith)
    End With
    
End Function

Private Sub ArrayToClip(arr As Variant)
'must add the reference “Microsoft Forms 2.0 Object Library” or FM20.DLL

    Dim objData As New MSForms.DataObject
    
    objData.SetText Join(arr, vbCrLf)
    objData.PutInClipboard
    
End Sub

Private Sub BubbleSort(arr)
'Small dataset, Bubblesort will suffice

    Dim i       As Long
    Dim j       As Long
    Dim lngMax  As Long
    Dim lngMin  As Long
    Dim strTemp As String

    lngMin = LBound(arr)
    lngMax = UBound(arr)

    For i = lngMin To lngMax - 1
        For j = i + 1 To lngMax
            If arr(i) > arr(j) Then
                strTemp = arr(i)
                arr(i) = arr(j)
                arr(j) = strTemp
            End If
        Next j
    Next i
  
End Sub

Private Function ClipToArray() As Variant
'must add the reference “Microsoft Forms 2.0 Object Library” or FM20.DLL
    Dim clip As New MSForms.DataObject
    Dim lines As String
    
    clip.GetFromClipboard
    lines = clip.GetText
    lines = Replace(lines, vbCr, "")
    ClipToArray = Split(lines, vbLf)
    
End Function

Private Function StripSpaces(ByRef arr As Variant)

    Dim intI    As Integer
    Dim strText As String
    
    For intI = LBound(arr) To UBound(arr)
        arr(intI) = RegExpReplace(arr(intI), "[\s]{2,}", " ")
    Next intI

End Function

 

[Ranman256]

who is that OCD to need that?

 

[Minty]

Neat - the old version of VBA indenter did this (not the sorting) but the proper indentation, and I loved it, it doesn't work with 64 Bit, unfortunately.

MZ tools indenter doesn't line it up as nicely.

(Like the labels on the tin cans in the larder)

 

[jdraw]

MZTools will allow you to sort your DIM statements alphabetically.

 

[Guus2005]

Yes, it requires some level of OCD. I know. But i like my code neat and tidy.

I have had contact with Carlos Quintero (creator of MZTools) about this feature or the ability to run code on the clipboard or under a shortcut. He told me that it is not going to happen any time soon, so i made this.

Try to see the trees in the forrest and you might like it