Opening the book…
Summary
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 Notes
- 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 Module
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.
Updates
- 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 Also
The book could not be loaded just now.