Key Points

• Each Case block implements formatting functionality for a specific format specifier.
• Goto statements indicate the function wants to be broken down into several smaller functions.
• Local variables such as alignmentSpecifier, alignmentPadding, precisionString, precisionSpecifier, formatSpecifier and all others, could all be eliminated if there was a concept of a "FormatSpecifier" object that held all these values.
• Bringing in escapeHex and the C# hex specifier is a hack easily made useless by correctly encapsulating each format specifier.
• escapes collection gets rebuilt every time the function is called, which is inefficient; valid escape sequences don't change from one call to the next.
• ASCII (hex & octal) escapes both desperately want to be part of that collection.
• Replacing \\ with ASCII code for Esc works nicely to get backslashes escaped.

---

Warning: below code is absolute overkill - no one in their right minds (I did this just for fun!) would do all this just to format strings in their VB6 or VBA application. However it shows how the monolithic function can be refactored to remove all Select...Case blocks and Goto statements.

---

Rewrite

Here's the refactored module-level function - it uses a Private helper As New StringHelper, declared at module level ("declarations" section):

Public Function StringFormat(format_string As String, ParamArray values()) As String Dim valuesArray() As Variant valuesArray = values StringFormat = helper.StringFormat(format_string, valuesArray) End Function 

Escape Sequences

The EscapeSequence class was annoyingly leaving out ASCII escapes, so I tackled this first:

Private Type tEscapeSequence EscapeString As String ReplacementString As String IsAsciiCharacter As Boolean AsciiBase As AsciiEscapeBase End Type Public Enum AsciiEscapeBase Octal Hexadecimal End Enum Private this As tEscapeSequence Option Explicit Public Property Get EscapeString() As String EscapeString = this.EscapeString End Property Friend Property Let EscapeString(value As String) this.EscapeString = value End Property Public Property Get ReplacementString() As String ReplacementString = this.ReplacementString End Property Friend Property Let ReplacementString(value As String) this.ReplacementString = value End Property Public Property Get IsAsciiCharacter() As Boolean IsAsciiCharacter = this.IsAsciiCharacter End Property Friend Property Let IsAsciiCharacter(value As Boolean) this.IsAsciiCharacter = value End Property Public Property Get AsciiBase() As AsciiEscapeBase AsciiBase = this.AsciiBase End Property Friend Property Let AsciiBase(value As AsciiEscapeBase) this.AsciiBase = value End Property 

The factory Create function was added two optional parameters; one to specify whether the escape sequence indicates an ASCII replacement escape, the other to specify the base (an enum) of the digits representing the ASCII code:

Public Function Create(escape As String, replacement As String, _ Optional ByVal isAsciiReplacement As Boolean = False, _ Optional ByVal base As AsciiEscapeBase = Octal) As EscapeSequence Dim result As New EscapeSequence result.EscapeString = escape result.ReplacementString = replacement result.IsAsciiCharacter = isAsciiReplacement result.AsciiBase = base Set Create = result End Function 

Added an Execute method here - all escape sequences boil down to the same thing: *replace the EscapeString with the ReplacementString, so we might as well encapsulate it here. ASCII escapes are a little bit more complex so I put them in their own method:

Public Sub Execute(ByRef string_value As String) If this.IsAsciiCharacter Then ProcessAsciiEscape string_value, this.EscapeString ElseIf StringContains(string_value, this.EscapeString) Then string_value = Replace(string_value, this.EscapeString, this.ReplacementString) End If End Sub Private Sub ProcessAsciiEscape(ByRef format_string As String, _ ByVal regexPattern As String) Dim regex As RegExp, matches As MatchCollection, thisMatch As Match Dim prefix As String, char As Long If Not StringContains(format_string, "\") Then Exit Sub Set regex = New RegExp regex.pattern = regexPattern regex.IgnoreCase = True regex.Global = True Select Case this.AsciiBase Case AsciiEscapeBase.Octal prefix = "&O" Case AsciiEscapeBase.Hexadecimal prefix = "&H" End Select Set matches = regex.Execute(format_string) For Each thisMatch In matches char = CLng(prefix & thisMatch.SubMatches(0)) format_string = Replace(format_string, thisMatch.value, Chr$(char)) Next Set regex = Nothing Set matches = Nothing End Sub 

This puts escape sequences to bed, at least for now.

Format Specifiers

Each match in the main RegEx stands for a placeholder (something potentially looking like "{0,-10:C2}"); if we can call those "format specifiers", they can probably deserve their own StringFormatSpecifier class as well - the precision specifier is normally an Integer, but in the custom date format it's also taking a String so we'll make Precision a get-only property that's set when assigning CustomSpecifier:

Private Type tSpecifier Index As Integer identifier As String AlignmentSpecifier As Integer PrecisionSpecifier As Integer CustomSpecifier As String End Type Private this As tSpecifier Option Explicit Public Property Get Index() As Integer Index = this.Index End Property Public Property Let Index(value As Integer) this.Index = value End Property Public Property Get identifier() As String identifier = this.identifier End Property Public Property Let identifier(value As String) this.identifier = value End Property Public Property Get Alignment() As Integer Alignment = this.AlignmentSpecifier End Property Public Property Let Alignment(value As Integer) this.AlignmentSpecifier = value End Property Public Property Get Precision() As Integer Precision = this.PrecisionSpecifier End Property Public Property Get CustomSpecifier() As String CustomSpecifier = this.CustomSpecifier End Property Public Property Let CustomSpecifier(value As String) this.CustomSpecifier = value If IsNumeric(value) And val(value) <> 0 Then this.PrecisionSpecifier = CInt(value) End Property 

All that's missing is a way to put all the pieces back together to perform the actual replacement - either we store the original string or we implement a ToString function:

Public Function ToString() As String ToString = "{" & this.Index & _ IIf(this.AlignmentSpecifier <> 0, _ "," & this.AlignmentSpecifier, vbNullString) & _ IIf(this.identifier <> vbNullString, _ ":" & this.identifier, vbNullString) & _ IIf(this.CustomSpecifier <> vbNullString, _ this.CustomSpecifier, vbNullString) & "}" End Function 

This puts another important piece to bed.

VB6 Interface?

If we encapsulated how each format specifier works into its own class, odds are we'd get over a dozen of very similar classes. If only we were in .net, we could create an interface for this, right? Very few people know that VB6 also supports interfaces. In fact, any class can be implemented by any other.

So the IStringFormatIdentifier interface/class looks like this:

Option Explicit 'returns a format string suitable for use with VB6's native Format() function. Public Function GetFormatString(specifier As StringFormatSpecifier) As String End Function 'returns the formatted value. Public Function GetFormattedValue(value As Variant, _ specifier As StringFormatSpecifier) As String End Function 'compares specified format identifier with implementation-defined one, 'returns true if format is applicable. Public Function IsIdentifierMatch(specifier As StringFormatSpecifier) As Boolean End Function 

This interface needs an implementation of it for each and every single Case block of the original code - not going to list them all here, but this is GeneralNumericStringFormatIdentifier (the most complicated one); notice that doing this has also eliminated the recursive function calls:

Implements IStringFormatIdentifier Option Explicit Private Function IStringFormatIdentifier_GetFormatString(specifier As StringFormatSpecifier) As String IStringFormatIdentifier_GetFormatString = vbNullString End Function Private Function IStringFormatIdentifier_GetFormattedValue(value As Variant, specifier As StringFormatSpecifier) As String Dim result As String Dim exponentialNotation As String Dim power As Integer Dim exponentialFormat As New ExponentialStringFormatIdentifier Dim fixedPointFormat As New FixedPointStringFormatIdentifier Dim decimalFormat As New DecimalStringFormatIdentifier Dim formatSpecifier As New StringFormatSpecifier formatSpecifier.Alignment = specifier.Alignment formatSpecifier.CustomSpecifier = specifier.CustomSpecifier If StringMatchesAny(TypeName(value), "Integer", "Long") Then formatSpecifier.identifier = IIf(specifier.identifier = "G", "D", "d") result = decimalFormat.GetFormattedValue(value, formatSpecifier) ElseIf TypeName(value) = "Double" Then formatSpecifier.identifier = IIf(specifier.identifier = "G", "E", "e") exponentialNotation = exponentialFormat.GetFormattedValue(value, formatSpecifier) power = exponentialFormat.GetPower(exponentialNotation) If power > -5 And Abs(power) < specifier.Precision Then formatSpecifier.identifier = IIf(specifier.identifier = "G", "F", "f") result = fixedPointFormat.GetFormattedValue(value, formatSpecifier) Else result = exponentialNotation End If End If IStringFormatIdentifier_GetFormattedValue = result Set exponentialFormat = Nothing Set fixedPointFormat = Nothing Set decimalFormat = Nothing Set formatSpecifier = Nothing End Function Public Function GetFormattedValue(value As Variant, specifier As StringFormatSpecifier) As String GetFormattedValue = IStringFormatIdentifier_GetFormattedValue(value, specifier) End Function Private Function IStringFormatIdentifier_IsIdentifierMatch(specifier As StringFormatSpecifier) As Boolean IStringFormatIdentifier_IsIdentifierMatch = UCase$(specifier.identifier) = "G" End Function 

Once every format identifier ("C", "D", "N", etc.) has its implementation of the IStringFormatIdentifier interface, we're ready to initialize everything we need, once.

The StringHelper class

Diving into the StringHelper class, the "declarations" section contains the error-handling constants, the default padding character and a private type that defines the encapsulated properties (I just do that in every class I write):

Private Const ERR_FORMAT_EXCEPTION As Long = vbObjectError Or 9001 Private Const ERR_SOURCE As String = "StringHelper" Private Const ERR_MSG_INVALID_FORMAT_STRING As String = "Invalid format string." Private Const ERR_MSG_FORMAT_EXCEPTION As String = "The number indicating an argument to format is less than zero, or greater than or equal to the length of the args array." Private Type tString PaddingCharacter As String * 1 EscapeSequences As New Collection NumericSpecifiers As New Collection DateTimeSpecifiers As New Collection End Type Private Const PADDING_CHAR As String * 1 = " " Private this As tString Option Base 0 Option Explicit 

Method Class_Initialize is where all the one-time stuff happens - this is where escape sequences, numeric and datetime specifiers are initialized:

Private Sub Class_Initialize() If this.PaddingCharacter = vbNullString Then this.PaddingCharacter = PADDING_CHAR InitEscapeSequences InitNumericSpecifiers InitDateTimeSpecifiers End Sub Private Sub InitEscapeSequences() Dim factory As New EscapeSequence Set this.EscapeSequences = New Collection this.EscapeSequences.Add factory.Create("\n", vbNewLine) this.EscapeSequences.Add factory.Create("\q", Chr$(34)) this.EscapeSequences.Add factory.Create("\t", vbTab) this.EscapeSequences.Add factory.Create("\a", Chr$(7)) this.EscapeSequences.Add factory.Create("\b", Chr$(8)) this.EscapeSequences.Add factory.Create("\v", Chr$(13)) this.EscapeSequences.Add factory.Create("\f", Chr$(14)) this.EscapeSequences.Add factory.Create("\r", Chr$(15)) this.EscapeSequences.Add factory.Create("\\x(\w{2})", 0, True, Hexadecimal) this.EscapeSequences.Add factory.Create("\\(\d{3})", 0, True, Octal) Set factory = Nothing End Sub Private Sub InitNumericSpecifiers() Set this.NumericSpecifiers = New Collection this.NumericSpecifiers.Add New CurrencyStringFormatIdentifier this.NumericSpecifiers.Add New DecimalStringFormatIdentifier this.NumericSpecifiers.Add New GeneralNumericStringFormatIdentifier this.NumericSpecifiers.Add New PercentStringFormatIdentifier this.NumericSpecifiers.Add New FixedPointStringFormatIdentifier this.NumericSpecifiers.Add New ExponentialStringFormatIdentifier this.NumericSpecifiers.Add New HexStringFormatIdentifier this.NumericSpecifiers.Add New RoundTripStringFormatIdentifier this.NumericSpecifiers.Add New NumericPaddingStringFormatIdentifier End Sub Private Sub InitDateTimeSpecifiers() Set this.DateTimeSpecifiers = New Collection this.DateTimeSpecifiers.Add New CustomDateFormatIdentifier this.DateTimeSpecifiers.Add New FullDateLongStringFormatSpecifier this.DateTimeSpecifiers.Add New FullDateShortStringFormatIdentifier this.DateTimeSpecifiers.Add New GeneralLongDateTimeStringFormatIdentifier this.DateTimeSpecifiers.Add New GeneralShortDateTimeStringFormatIdentifier this.DateTimeSpecifiers.Add New LongDateFormatIdentifier this.DateTimeSpecifiers.Add New LongTimeStringFormatIdentifier this.DateTimeSpecifiers.Add New ShortDateFormatIdentifier this.DateTimeSpecifiers.Add New SortableDateTimeStringFormatIdentifier End Sub 

To make the PaddingCharacter configurable, it only needs to be exposed as a property.

So let's recap here, we have:

• A collection of escape sequences that know how to to process themselves
• A collection of numeric specifiers that know how to process themselves
• A collection of date/time specifiers that know how to process themselves

All we're missing is a function that will take a format_string, validate it and return a collection of StringFormatSpecifier. The regular expression we're using to do this can also be simplified a bit - unfortunately this doesn't make it run any faster (performance-wise, this function is really where the bottleneck is):

Private Function GetFormatSpecifiers(ByVal format_string As String, valuesCount As Integer) As Collection 'executes a regular expression against format_string to extract all placeholders into a MatchCollection Dim regex As New RegExp Dim matches As MatchCollection Dim thisMatch As Match Dim result As New Collection Dim specifier As StringFormatSpecifier Dim csvIndices As String Dim uniqueCount As Integer Dim largestIndex As Integer regex.pattern = "\{(\w+)(\,\-?\d+)?(\:[^}]+)?\}" ' literal { ' [1] numbered captured group, any number of repetitions (Index) ' alphanumeric, one or more repetitions ' [2] numbered captured group, zero or one repetitions (AlignmentSpecifier) ' literal , ' literal -, zero or one repetitions ' any digit, one or more repetitions ' [3] numbered captured group, zero or one repetitions (FormatSpecifier) ' literal : ' any character except '}', one or more repetitions ' literal } regex.IgnoreCase = True regex.Global = True Set matches = regex.Execute(format_string) For Each thisMatch In matches Set specifier = New StringFormatSpecifier specifier.Index = CInt(thisMatch.SubMatches(0)) If Not StringContains(csvIndices, specifier.Index & ",") Then uniqueCount = uniqueCount + 1 csvIndices = csvIndices & specifier.Index & "," End If If specifier.Index > largestIndex Then largestIndex = specifier.Index If Not thisMatch.SubMatches(1) = vbEmpty Then specifier.Alignment = CInt(Replace(CStr(thisMatch.SubMatches(1)), ",", vbNullString)) If Not thisMatch.SubMatches(2) = vbEmpty Then specifier.identifier = Left(Replace(CStr(thisMatch.SubMatches(2)), ":", vbNullString), 1) specifier.CustomSpecifier = Replace(CStr(thisMatch.SubMatches(2)), ":" & specifier.identifier, vbNullString) End If result.Add specifier Next If matches.Count > 0 And (uniqueCount <> valuesCount) Or (largestIndex >= uniqueCount) Or valuesCount = 0) Then Err.Raise ERR_FORMAT_EXCEPTION, ERR_SOURCE, ERR_MSG_FORMAT_EXCEPTION Set GetFormatSpecifiers = result Set regex = Nothing Set matches = Nothing End Function 

The actual StringFormat function takes an array of Variant sent from the module function's ParamArray values() parameter; taking a ParamArray here as well would make things more complicated than they already are.

So all the function really needs to do, is loop through all specifiers in format_string, and apply the appropriate format specifier's formatting. Then apply the alignment specifier and execute escape sequences (unless format_string starts with a "@") - with everything properly encapsulated in specialized objects, this should leave a pretty readable implementation:

Public Function StringFormat(format_string As String, values() As Variant) As String Dim result As String result = format_string Dim specifiers As Collection Dim specifier As StringFormatSpecifier Set specifiers = GetFormatSpecifiers(result, UBound(values) + 1) Dim useLiteral As Boolean 'when format_string starts with "@", escapes are not replaced '(string is treated as a literal string with placeholders) useLiteral = StringStartsWith("@", result) 'remove the "@" literal specifier from the result string If useLiteral Then result = Right(result, Len(result) - 1) 'replace escaped backslashes with 'ESC' character [Chr$(27)] 'to optimize escape sequences evaluation: If Not useLiteral And StringContains(result, "\\") Then _ result = Replace(result, "\\", Chr$(27)) Dim formattedValue As String Dim alignmentPadding As Integer Dim identifier As IStringFormatIdentifier Dim identifierFound As Boolean For Each specifier In specifiers formattedValue = values(specifier.Index) identifierFound = (specifier.identifier = vbNullString) If IsNumeric(values(specifier.Index)) Then For Each identifier In this.NumericSpecifiers If identifier.IsIdentifierMatch(specifier) Then identifierFound = True formattedValue = identifier.GetFormattedValue(values(specifier.Index), specifier) End If Next ElseIf TypeName(values(specifier.Index)) = "Date" Then For Each identifier In this.DateTimeSpecifiers If identifier.IsIdentifierMatch(specifier) Then identifierFound = True formattedValue = identifier.GetFormattedValue(values(specifier.Index), specifier) End If Next End If If Not identifierFound Then Err.Raise ERR_FORMAT_EXCEPTION, ERR_SOURCE, ERR_MSG_INVALID_FORMAT_STRING alignmentPadding = Abs(specifier.Alignment) If specifier.Alignment < 0 Then 'negative: left-justified alignment If alignmentPadding - Len(formattedValue) > 0 Then _ formattedValue = formattedValue & String$(alignmentPadding - Len(formattedValue), this.PaddingCharacter) ElseIf specifier.Alignment > 0 Then 'positive: right-justified alignment If alignmentPadding - Len(formattedValue) > 0 Then _ formattedValue = String$(alignmentPadding - Len(formattedValue), this.PaddingCharacter) & formattedValue End If 'replace all occurrences of placeholder {i} with their formatted values: result = Replace(result, specifier.ToString, formattedValue) Next Dim escape As EscapeSequence If Not useLiteral And StringContains(result, "\") Then For Each escape In this.EscapeSequences escape.Execute result Next End If If Not useLiteral And StringContains(result, Chr$(27)) Then result = Replace(result, Chr$(27), "\") StringFormat = result End Function 

Feel free to comment below! :)