Visual Basic for Applications/Array Data To Immediate Window

SummaryEdit

This VBA code module allows the listing of arrays in the immediate window. So that the user can see examples of its use, it makes use of various procedures that fill the array for demonstration and testing. The VBA code runs in MS Excel but is easily adapted for any of the MS Office products that run VBA. Clearly, mixed data varies in length and in its number of decimal points. This module displays the array neatly taking account of the variations that might otherwise disrupt the layout. It can decimal point align the data or not, according to internal options.

Code NotesEdit

  • DispArrInImmWindow() is the main procedure. It formats and prints data found on the two dimensional input array. It prints on the VBA Editor's Immediate Window. Options include the printing of data as found or making use of decimal rounding and alignment. The entire output print is also available as a string for external use. The process depends on monospaced fonts being set for any display, including the VBA editor.
  • RndAlphaToArr(), RndNumericToArr(), and RndMixedDataToArr() load an array with random data. The data is random in the content and length of elements, but in addition, numerics have random integer and decimal parts. Each allows adjustment of options internally to accommodate personal preferences.
  • TabularAlignTxtOrNum() is not used in this demonstration. It is included for those who prefer to format each individual column of an array during the loading process. Its input variant takes a single string or number and returns the formatted result in a user-set fixed field width. The number of decimal places of rounding can be set. Note that when all data in a column of a numeric array is loaded with the same parameters, the result is always decimal point alignment.
  • WriteToFile() is a monospaced font, text file-making procedure. If the file name does not exist, it will be made and saved automatically. Each save of text will completely replace any previously added. It is added here in case a user needs to save an output greater than that possible for the Immediate Window. The Immediate Window is limited to about two hundred lines of code, so large arrays should make use of the main procedure's sOut string. Again, wherever outputs from the main procedure are used, monospaced fonts are assumed.
  • Note that the user might add a procedure to export large values of sOut, the formatted string, to the clipboard. Procedures exist elsewhere in this series that will accomplish this.

The VBA ModuleEdit

Copy the entire code module into a standard VBA module, save the file as type .xlsm and run the top procedure. Be sure to set monospaced fonts for the VBA editor or the object will have been defeated.

UpdatesEdit

  • 26 Nov 2019: Adjusted DispArrInImmWindow() code to better estimate maximum column width, taking account of imposed decimal places.
Option Explicit

Private Sub testDispArrInImmWindow()
    'Run this to display a selection of data arrays
    'in the immediate window. Auto formatting
    'includes rounding and decimal point alignment.
    'Alternative is to print data untouched.
    'SET IMMEDIATE WINDOW FONT TO MONOSPACED
    'Eg: Consolas or Courier.
    
    Dim vArr As Variant, vArr2 As Variant, sOutput As String
     
    'clear the immediate window
    ClearImmWindow
    
    'UNFORMATTED random length alpha strings
    RndAlphaToArr vArr, 5, 6        'length setting made in proc
    vArr2 = vArr
    Debug.Print "UNFORMATTED"
    DispArrInImmWindow vArr, False, 2
    'FORMATTED random length alpha strings
    Debug.Print "FORMATTED"
    DispArrInImmWindow vArr2, True, 2
    
    
    'UNFORMATTED random length numbers and decimals
    RndNumericToArr vArr, 5, 6      'various settings made in proc
    vArr2 = vArr
    Debug.Print "UNFORMATTED"
    DispArrInImmWindow vArr, False, 2
    'FORMATTED random length numbers and decimals
    Debug.Print "FORMATTED"
    DispArrInImmWindow vArr2, True, 2
    
        
    'UNFORMATTED random alpha and number alternating columns
    RndMixedDataToArr vArr, 5, 6    'various settings made in proc
    vArr2 = vArr
    Debug.Print "UNFORMATTED"
    DispArrInImmWindow vArr, False, 2
    'FORMATTED random alpha and number alternating columns
    Debug.Print "FORMATTED"
    DispArrInImmWindow vArr2, True, 2, sOutput
    
    'output whole string version to a log file
    'WriteToFile sOutput, ThisWorkbook.Path & "\MyLongArray.txt"

End Sub

Private Sub ClearImmWindow()
    
    'NOTES
    'Clears VBA immediate window down to the insertion point,
    'but not beyond. Not a problem as long as cursor is
    'at end of text, but otherwise not.
    'Clear manually before any neat work.
    'Manual clear method: Ctrl-G then Ctrl-A then Delete.
    
    'Max display in immediate window is 199 lines,
    'then top lines are lost as new ones added at bottom.
    'No reliable code method exists.
    
    Debug.Print String(200, vbCrLf)
    
End Sub

Private Sub DispArrInImmWindow(vA As Variant, Optional ByVal bFormatAlignData = True, _
                                  Optional ByVal nNumDecs As Integer = 2, _
                                     Optional sOut As String)

    '--------------------------------------------------------------------------
    'vA :               Input 2D array for display in the immediate window.
    'sOut:              Alternative formatted output string.
    'bFormatAlignData : True: applies decimal rounding and decimal alignment,
    '                   False: data untouched with only basic column spacing.
    'nNumDecs:          Sets the rounding up and down of decimal places.
    '                   Integers do not have zeros added at any time.
    'Clear the immediate window before each run for best results.
    'The immediate window at best lists 199 lines before overwrite, so
    'consider using sOut for large arrays.  'ie; use it in a text file
    'or userform textbox. Both outputs depend on the use of MONOSPACED fonts,
    'so set the font VBA editor or any textbox to Courier or Consolas.
    'To set different formats for EVERY column of an array it is best to add
    'the formats at loading time with the procedure TabularAlignTxtOrNumber().
    '--------------------------------------------------------------------------
    
    'messy when integers are set in array and decimals is set say to 3.
    'maybe the measurement of max element width should include a measure
    ' for any dot or extra imposed decimal places as well
    'different for integers and for existing decimals
        
    Dim vD As Variant, vC As Variant, nInterFieldSpace As Integer
    Dim sPadding As String, sDecFormat As String, sR As String, sE As String
    Dim r As Integer, c As Integer, m As Integer, n As Integer, nP As Integer
    Dim nMaxFieldWidth As Integer, bSkip As Boolean
    Dim LB1 As Long, UB1 As Long, LB2 As Long, UB2 As Long
    
    'get bounds of input array
    LB1 = LBound(vA, 1): UB1 = UBound(vA, 1)
    LB2 = LBound(vA, 2): UB2 = UBound(vA, 2)
    
    ReDim vD(LB1 To UB1, LB2 To UB2) 'display
    ReDim vC(LB2 To UB2)             'column max
    
    '--------------------------------------
    'set distance between fixed width
    'fields in the output display
    nInterFieldSpace = 3
    'not now used
    nMaxFieldWidth = 14
    '--------------------------------------
    
    If nNumDecs < 0 Then
        MsgBox "nNumDecs parameter must not be negative - closing"
        Exit Sub
    End If
        
    'find widest element in each column
    'and adjust it for any imposed decimal places
    For c = LB2 To UB2
        n = 0: m = 0
        For r = LB1 To UB1
            'get element length
            If IsNumeric(vA(r, c)) Then
                If Int(vA(r, c)) = vA(r, c) Then 'is integer
                    n = Len(vA(r, c)) + 1 + nNumDecs
                Else 'is not integer
                    If Len(vA(r, c)) - Len(Int(vA(r, c))) - 1 >= nNumDecs Then 'no change
                        n = Len(vA(r, c))
                    Else  'add the difference in length as result of imposed decimal places
                        n = Len(vA(r, c)) + (nNumDecs - (Len(vA(r, c)) - Len(Int(vA(r, c))) - 1))
                    End If
                End If
            Else
                n = Len(vA(r, c))
            End If
            
            If n > m Then m = n 'update if longer
        Next r
        'store the maximum length
        'of data in each column
        vC(c) = m
    Next c
        
    For c = LB2 To UB2
        For r = LB1 To UB1
            sE = Trim(vA(r, c))

            If bFormatAlignData = False Then
                sDecFormat = sE
                nP = InStr(sE, ".")
                bSkip = True
            End If

            'make a basic format
            If bSkip = False Then
                nP = InStr(sE, ".")
                'numeric with a decimal point
                If IsNumeric(sE) = True And nP > 0 Then
                    sDecFormat = Format$(sE, "0." & String$(nNumDecs, "0"))
                'integer
                ElseIf IsNumeric(sE) = True And nP <= 0 Then
                    sDecFormat = Format$(sE, "0") & String$(nNumDecs + 1, Chr(32))
                'alpha
                ElseIf IsNumeric(sE) = False Then
                    sDecFormat = sE
                End If
            End If
  
            'adjust field width to widest in column
            bSkip = False
            sPadding = Space$(vC(c))
            'numeric with a decimal point
            If IsNumeric(sE) = True And nP > 0 Then
                vD(r, c) = Right$(sPadding & sDecFormat, vC(c))
            'integer
            ElseIf IsNumeric(sE) = True And nP <= 0 Then
                vD(r, c) = Right$(sPadding & sDecFormat, vC(c))
            'alpha
            ElseIf IsNumeric(sE) = False Then
                vD(r, c) = Left$(sDecFormat & sPadding, vC(c))
            End If
        Next r
    Next c
        
    'output
    sOut = ""
    For r = LB1 To UB1
        For c = LB2 To UB2
            sR = sR & vD(r, c) & Space(nInterFieldSpace) 'concat one row
        Next c
        Debug.Print sR             'print one row in imm window
        sOut = sOut & sR & vbCrLf  'accum one row in output string
        sR = ""
    Next r
    sOut = sOut & vbCrLf
    Debug.Print vbCrLf

End Sub

Private Sub RndAlphaToArr(vIn As Variant, nRows As Integer, nCols As Integer)
    'loads a 2D array in place with random string lengths
            
    Dim sT As String, sAccum As String, nMinLenStr As Integer
    Dim n As Long, nLenWord As Integer, nMaxLenStr As Integer
    Dim nAsc As Integer, r As Long, c As Long
    Dim LB1 As Long, UB1 As Long, LB2 As Long, UB2 As Long
    
    ReDim vIn(1 To nRows, 1 To nCols)
    
    LB1 = LBound(vIn, 1): UB1 = UBound(vIn, 1)
    LB2 = LBound(vIn, 2): UB2 = UBound(vIn, 2)
        
    '--------------------------------------------------
    'set minimum and maximum strings lengths here
    nMinLenStr = 2   'the minimum random text length
    nMaxLenStr = 8  'the maximum random text length
    '--------------------------------------------------
    
    Randomize
    For r = LB1 To UB1
        For c = LB2 To UB2
            nLenWord = Int((nMaxLenStr - nMinLenStr + 1) * Rnd + nMinLenStr)
            
            'make one random length string
            For n = 1 To nLenWord
                nAsc = Int((90 - 65 + 1) * Rnd + 65)
                sT = Chr$(nAsc)
                sAccum = sAccum & sT
            Next n
            
            'store string
            vIn(r, c) = sAccum
            sAccum = "": sT = ""
        Next c
    Next r

End Sub

Private Sub RndNumericToArr(vIn As Variant, nRows As Integer, nCols As Integer)
    'loads a 2D array in place with random number lengths
    
    Dim sT1 As String, sT2 As String, nMinLenDec As Integer, sSign As String
    Dim sAccum1 As String, sAccum2 As String, nMaxLenDec As Integer
    Dim nLenInt As Integer, nLenDecs As Integer, nMinLenInt As Integer
    Dim n As Long, r As Long, c As Long, nAsc As Integer, nMaxLenInt As Integer
    Dim LB1 As Long, UB1 As Long, LB2 As Long, UB2 As Long
    
    ReDim vIn(1 To nRows, 1 To nCols)
    
    LB1 = LBound(vIn, 1): UB1 = UBound(vIn, 1)
    LB2 = LBound(vIn, 2): UB2 = UBound(vIn, 2)
      
    '--------------------------------------------------
    'set user minimum and maximum settings here
    nMinLenDec = 0   'the minumum decimal part length
    nMaxLenDec = 4   'the maximum decimal part length
    nMinLenInt = 1   'the minimum integer part length
    nMaxLenInt = 4   'the maximum integer part length
    '--------------------------------------------------
    
    Randomize
    For r = LB1 To UB1
        For c = LB2 To UB2
            nLenInt = Int((nMaxLenInt - nMinLenInt + 1) * Rnd + nMinLenInt)
            nLenDecs = Int((nMaxLenDec - nMinLenDec + 1) * Rnd + nMinLenDec)
            'make one random length integer string
            For n = 1 To nLenInt
                    If nLenInt = 1 Then                      'exclude zero choice
                        nAsc = Int((57 - 48 + 1) * Rnd + 48)
                    ElseIf nLenInt <> 1 And n = 1 Then       'exclude zero choice
                        nAsc = Int((57 - 48 + 1) * Rnd + 48)
                    Else
                        nAsc = Int((57 - 49 + 1) * Rnd + 49) 'all other digits
                    End If
                    
                    sT1 = Chr$(nAsc)
                    sAccum1 = sAccum1 & sT1
                Next n
            'make one random length decimal part
            For n = 0 To nLenDecs
                nAsc = Int((57 - 48 + 1) * Rnd + 48)
                sT2 = Chr$(nAsc)
                sAccum2 = sAccum2 & sT2
            Next n
            'decide whether or not a negative number
            nAsc = Int((5 - 1 + 1) * Rnd + 1) 'one in five negative
            If nAsc = 5 Then sSign = "-" Else sSign = ""
            
            'store string
            If nLenDecs <> 0 Then
                vIn(r, c) = CSng(sSign & sAccum1 & "." & sAccum2)
            Else
                vIn(r, c) = CSng(sSign & sAccum1)
            End If
                    
            sT1 = "": sT2 = ""
            sAccum1 = "": sAccum2 = ""
            'MsgBox vIn(r, c)
        Next c
    Next r
End Sub

Private Sub RndMixedDataToArr(vIn As Variant, nRows As Integer, nCols As Integer)
    'loads a 2D array in place with random string lengths
    
    Dim sAccum As String, nMinLenStr As Integer, sSign As String
    Dim n As Long, nLenWord As Integer, nMaxLenStr As Integer
    Dim nAsc As Integer, r As Long, c As Long, nMaxLenDec As Integer
    Dim sT As String, sT1 As String, sT2 As String, nMinLenDec As Integer
    Dim sAccum1 As String, sAccum2 As String, nMinLenInt As Integer
    Dim nLenInt As Integer, nLenDecs As Integer, nMaxLenInt As Integer
    Dim LB1 As Long, UB1 As Long, LB2 As Long, UB2 As Long
    
    ReDim vIn(1 To nRows, 1 To nCols)
    
    LB1 = LBound(vIn, 1): UB1 = UBound(vIn, 1)
    LB2 = LBound(vIn, 2): UB2 = UBound(vIn, 2)
        
    '--------------------------------------------------
    'set user minimum and maximum settings here
    nMinLenStr = 3   'the minimum random text length
    nMaxLenStr = 8   'the maximum random text length
    nMinLenDec = 0   'the minumum decimal part length
    nMaxLenDec = 4   'the maximum decimal part length
    nMinLenInt = 1   'the minimum integer part length
    nMaxLenInt = 4   'the maximum integer part length
    '--------------------------------------------------
    
    Randomize
    For r = LB1 To UB1
        For c = LB2 To UB2
            If c Mod 2 <> 0 Then
                
                nLenWord = Int((nMaxLenStr - nMinLenStr + 1) * Rnd + nMinLenStr)
                
                'make one random length string
                For n = 1 To nLenWord
                    nAsc = Int((90 - 65 + 1) * Rnd + 65)
                    sT = Chr$(nAsc)
                    sAccum = sAccum & sT
                Next n
                
                'store string
                vIn(r, c) = sAccum
                sAccum = "": sT = ""
            Else
                nLenInt = Int((nMaxLenInt - nMinLenInt + 1) * Rnd + nMinLenInt)
                nLenDecs = Int((nMaxLenDec - nMinLenDec + 1) * Rnd + nMinLenDec)
                'make one random length integer string
                For n = 1 To nLenInt
                    If nLenInt = 1 Then                      'exclude zero choice
                        nAsc = Int((57 - 48 + 1) * Rnd + 48)
                    ElseIf nLenInt <> 1 And n = 1 Then       'exclude zero choice
                        nAsc = Int((57 - 48 + 1) * Rnd + 48)
                    Else
                        nAsc = Int((57 - 49 + 1) * Rnd + 49) 'all other digits
                    End If
                    
                    sT1 = Chr$(nAsc)
                    sAccum1 = sAccum1 & sT1
                Next n
                'make one random length decimal part
                If nLenDecs <> 0 Then
                    For n = 1 To nLenDecs
                        nAsc = Int((57 - 48 + 1) * Rnd + 48)
                        sT2 = Chr$(nAsc)
                        sAccum2 = sAccum2 & sT2
                    Next n
                Else
                        sAccum2 = ""
                End If
                'decide whether or not a negative number
                nAsc = Int((5 - 1 + 1) * Rnd + 1) 'one in five negative
                If nAsc = 5 Then sSign = "-" Else sSign = ""
                            
                'store string
                If nLenDecs <> 0 Then
                    vIn(r, c) = CSng(sSign & sAccum1 & "." & sAccum2)
                Else
                    vIn(r, c) = CSng(sSign & sAccum1)
                End If
                        
                sT1 = "": sT2 = ""
                sAccum1 = "": sAccum2 = ""
            End If
        Next c
    Next r

End Sub

Sub testNumDecAlign()
    'produces examples in immediate window for single entries
    
    'clear the immediate window
    ClearImmWindow
    
    Debug.Print "|" & TabularAlignTxtOrNum(Cos(30), 3, 12) & "|"
    Debug.Print "|" & TabularAlignTxtOrNum("Text Heading", 3, 12) & "|"
    Debug.Print "|" & TabularAlignTxtOrNum(345.746453, 3, 12) & "|"
    Debug.Print "|" & TabularAlignTxtOrNum(56.5645, 0, 12) & "|"
    Debug.Print vbCrLf

End Sub

Private Function TabularAlignTxtOrNum(vIn As Variant, nNumDecs As Integer, _
                      nFieldWidth As Integer) As String
    'Notes:
    'Returns vIn in function name, formatted to given number of decimals,
    'and padded for display. VIn can contain an alpha string, a numeric
    'string, or a number. nNumDecs is intended number of decimals
    'in the output and nFieldWidth is its total padded width.
    'Non-numerics are left-aligned and numerics are right-aligned.
    'Decimal alignment results when say, all of an array column is
    'formatted with the same parameters.
    'ASSUMES THAT A MONOSPACED FONT WILL BE USED FOR DISPLAY
    
    Dim sPadding As String, sDecFormat As String
        
    'make a format based on whether numeric and how many decimals
    If IsNumeric(vIn) Then
        If nNumDecs > 0 Then                 'decimals
            sDecFormat = Format$(vIn, "0." & String$(nNumDecs, "0"))
        Else
            sDecFormat = Format$(vIn, "0") 'no decimals
        End If
    Else
            sDecFormat = vIn                 'non numeric
    End If
            
    'get a space string equal to max width
    sPadding = Space$(nFieldWidth)
    
    'combine and limit width
    If IsNumeric(vIn) Then
    'combine and limit width
        TabularAlignTxtOrNum = Right$(sPadding & sDecFormat, nFieldWidth)
    Else
        TabularAlignTxtOrNum = Left$(sDecFormat & sPadding, nFieldWidth)
    End If

End Function

Function WriteToFile(sIn As String, sPath As String) As Boolean
    'REPLACES all content of text file with parameter string
    'makes file if does not exist
    'no layout or formatting - assumes external
    
    Dim Number As Integer
    
    Number = FreeFile 'Get a file number
    
    'write string to file
    Open sPath For Output As #Number
    Print #Number, sIn
    Close #Number

    WriteToFile = True
    
End Function

See AlsoEdit