├── .gitattributes ├── .github └── FUNDING.yml ├── Code Modules ├── Demo Modules │ ├── DEMO_General.bas │ └── DEMO_Timing.bas └── StringBuffer.cls ├── LICENSE ├── README.md └── VBA StringBuffer_Demo.xlsm /.gitattributes: -------------------------------------------------------------------------------- 1 | *.bas eol=crlf 2 | *.cls eol=crlf -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: cristianbuse 2 | -------------------------------------------------------------------------------- /Code Modules/Demo Modules/DEMO_General.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "DEMO_General" 2 | Option Explicit 3 | Option Private Module 4 | 5 | Private Const MODULE_NAME As String = "DEMO_General" 6 | 7 | '******************************************************************************* 8 | 'Converts an array of Variants into a tab delimited text 9 | '******************************************************************************* 10 | Public Function TabDelimitedTextFrom2DArray(ByRef arr As Variant) As String 11 | Const methodName As String = "TabDelimitedTextFrom2DArray" 12 | ' 13 | If GetDimensionsCount(arr) <> 2 Then 14 | Err.Raise 5, MODULE_NAME & "." & methodName, "Expected 2D Array" 15 | End If 16 | ' 17 | Dim i As Long 18 | Dim j As Long 19 | Dim lowerRowBound As Long: lowerRowBound = LBound(arr, 1) 20 | Dim upperRowBound As Long: upperRowBound = UBound(arr, 1) 21 | Dim lowerColBound As Long: lowerColBound = LBound(arr, 2) 22 | Dim upperColBound As Long: upperColBound = UBound(arr, 2) 23 | Dim buff As New StringBuffer 24 | ' 25 | On Error GoTo ErrorHandler 26 | For i = lowerRowBound To upperRowBound 27 | For j = lowerColBound To upperColBound 28 | If IsNull(arr(i, j)) Then 29 | buff.Append "NULL" 30 | Else 31 | buff.Append CStr(arr(i, j)) 32 | End If 33 | If j < upperColBound Then buff.Append vbTab 34 | Next j 35 | If i < upperRowBound Then buff.Append vbNewLine 36 | Next i 37 | ' 38 | TabDelimitedTextFrom2DArray = buff.Value 39 | Exit Function 40 | ErrorHandler: 41 | Err.Raise Err.Number, MODULE_NAME & "." & methodName, "Invalid Array Value" 42 | End Function 43 | 44 | '******************************************************************************* 45 | 'Returns the Number of dimensions for an input array 46 | '******************************************************************************* 47 | Public Function GetDimensionsCount(ByVal inputArray As Variant) As Long 48 | Dim dimensionIndex As Long 49 | Dim dimensionBound As Long 50 | ' 51 | 'Increse the dimension index and loop until an error occurs 52 | On Error GoTo FinalDimension 53 | For dimensionIndex = 1 To 60000 54 | dimensionBound = LBound(inputArray, dimensionIndex) 55 | Next dimensionIndex 56 | Exit Function 57 | FinalDimension: 58 | GetDimensionsCount = dimensionIndex - 1 59 | End Function 60 | 61 | Public Sub BufferMethodsDemo() 62 | Dim buff As New StringBuffer 63 | ' 64 | buff.Append "ABFGH" 65 | Debug.Print buff.Value 'ABFGH 66 | ' 67 | buff.Insert 3, "CDE" 68 | Debug.Print buff 'ABCDEFGH 69 | ' 70 | buff.Reverse 71 | Debug.Print buff 'HGFEDCBA 72 | ' 73 | buff.Replace 2, 2, "XX" 74 | Debug.Print buff 'HXXEDCBA 75 | ' 76 | buff.Reverse 77 | Debug.Print buff 'ABCDEXXH 78 | ' 79 | buff.Delete 6, 2 80 | Debug.Print buff 'ABCDEH 81 | ' 82 | Debug.Print buff.Substring(2, 3) 'BCD 83 | End Sub 84 | -------------------------------------------------------------------------------- /Code Modules/Demo Modules/DEMO_Timing.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "DEMO_Timing" 2 | Option Explicit 3 | Option Private Module 4 | 5 | Public Function TestAppendTimeNoBuffer(ByVal wordsCount As Long, wordLength As Long) As Variant 6 | 'Check Input 7 | If wordsCount < 1 Then GoTo FailInput 8 | If wordLength < 1 Then GoTo FailInput 9 | If wordsCount * wordLength > &H7FFFFFFF Then GoTo FailInput 10 | ' 11 | Dim i As Long 12 | Dim resultString As String 13 | Dim word As String: word = String$(wordLength, "A") 14 | Dim tStart As Date: tStart = TimeNow 15 | ' 16 | For i = 1 To wordsCount 17 | resultString = resultString & word 'regular VB concatenation with new memory allocation 18 | Next i 19 | ' 20 | TestAppendTimeNoBuffer = TimeToSeconds(TimeNow - tStart) 21 | Exit Function 22 | FailInput: 23 | TestAppendTimeNoBuffer = CVErr(xlErrValue) 24 | End Function 25 | 26 | Public Function TestAppendTimeWithBuffer(ByVal wordsCount As Long, wordLength As Long) As Variant 27 | 'Check Input 28 | If wordsCount < 1 Then GoTo FailInput 29 | If wordLength < 1 Then GoTo FailInput 30 | If wordsCount * wordLength > 2147483647 Then GoTo FailInput 31 | ' 32 | Dim i As Long 33 | Dim resultString As String 34 | Dim word As String: word = String$(wordLength, "A") 35 | Dim buff As New StringBuffer 36 | Dim tStart As Date: tStart = TimeNow 37 | ' 38 | For i = 1 To wordsCount 39 | buff.Append word 40 | Next i 41 | resultString = buff 'or buff.Value 42 | Set buff = Nothing 43 | ' 44 | TestAppendTimeWithBuffer = TimeToSeconds(TimeNow - tStart) 45 | Exit Function 46 | FailInput: 47 | TestAppendTimeWithBuffer = CVErr(xlErrValue) 48 | End Function 49 | 50 | '******************************************************************************* 51 | 'Timing 52 | '******************************************************************************* 53 | Public Function TimeNow() As Date 54 | Dim t As Double 55 | ' 56 | #If Mac Then 57 | Dim varTemp As Variant 58 | ' 59 | varTemp = Evaluate("=Now()") 'Resolution of 0.01 seconds 60 | If VBA.IsError(varTemp) Then 61 | t = VBA.Now() 'Resolution of 1 second 62 | Else 63 | t = varTemp 64 | End If 65 | t = t - Int(t) 66 | #Else 67 | t = VBA.Timer / 86400 68 | #End If 69 | TimeNow = t 70 | End Function 71 | Public Function TimeToSeconds(ByVal time_ As Date) As Double 72 | 'There are 86,400 seconds in a day (24h * 60m * 60s) 73 | 'Convert from day fraction (time) to seconds 74 | TimeToSeconds = Round(time_ * 86400, 3) 75 | End Function 76 | -------------------------------------------------------------------------------- /Code Modules/StringBuffer.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "StringBuffer" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | '''============================================================================= 11 | ''' VBA StringBuffer 12 | '''------------------------------------------------- 13 | ''' https://github.com/cristianbuse/VBA-StringBuffer 14 | '''------------------------------------------------- 15 | ''' 16 | ''' Copyright (c) 2019 Ion Cristian Buse 17 | ''' 18 | ''' Permission is hereby granted, free of charge, to any person obtaining a copy 19 | ''' of this software and associated documentation files (the "Software"), to deal 20 | ''' in the Software without restriction, including without limitation the rights 21 | ''' to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 22 | ''' copies of the Software, and to permit persons to whom the Software is 23 | ''' furnished to do so, subject to the following conditions: 24 | ''' 25 | ''' The above copyright notice and this permission notice shall be included in all 26 | ''' copies or substantial portions of the Software. 27 | ''' 28 | ''' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 29 | ''' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 30 | ''' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 31 | ''' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 32 | ''' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 33 | ''' OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 34 | ''' SOFTWARE. 35 | '''============================================================================= 36 | ''============================================================================== 37 | '' Description: 38 | '' * A 'Java-like' string buffer 39 | '' The main methods are (both using the 'Mid' statement for speed): 40 | '' * Append (much faster than using regular VBA concatenation - & operator) 41 | '' * Insert 42 | '' Other useful methods: 43 | '' * Delete 44 | '' * Replace 45 | '' * Reset 46 | '' * Reverse 47 | '' * Substring 48 | '' Retrieve value by calling property: 49 | '' * Value (default class member - can be omitted) 50 | '' Notes: 51 | '' * The buffer's capacity should only be increased by using the 52 | '' EnsureCapacity method 53 | ''============================================================================== 54 | 55 | Option Explicit 56 | 57 | 'Internal BUFFER Struct 58 | Private Type BUFFER_STRUCT 59 | text_ As String 60 | endIndex_ As Long 61 | capacity_ As Long 62 | End Type 63 | 64 | 'Class members 65 | Private m_buffer As BUFFER_STRUCT 66 | 67 | '******************************************************************************* 68 | 'Append new text to buffer 69 | '******************************************************************************* 70 | Public Sub Append(ByRef textToAppend As String) 71 | Dim addedLength As Long: addedLength = VBA.Len(textToAppend) 72 | If addedLength = 0 Then Exit Sub 73 | Dim newEndIndex As Long: newEndIndex = m_buffer.endIndex_ + addedLength 74 | ' 75 | 'EnsureCapacity already checks for: newEndIndex > m_buffer.capacity_ 76 | 'When many appends are done (ex. 1 character at a time for a million times) 77 | ' then the extra 'If' is faster than exiting the scope of this function 78 | ' i.e. avoid pushing a new stack frame at the top of the call stack 79 | If newEndIndex > m_buffer.capacity_ Then EnsureCapacity newEndIndex 80 | ' 81 | 'Replace unused characters with the new text after the last used position 82 | 'The Mid Statement can be used to quickly replace characters 83 | 'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-statement 84 | Mid$(m_buffer.text_, m_buffer.endIndex_ + 1, addedLength) = textToAppend 85 | ' 86 | 'Store last character position 87 | m_buffer.endIndex_ = newEndIndex 88 | End Sub 89 | 90 | '******************************************************************************* 91 | 'Delete a portion of the text 92 | '******************************************************************************* 93 | Public Sub Delete(ByVal startIndex As Long, ByVal length_ As Long) 94 | 'Validate Input 95 | If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then 96 | Err.Raise 9, TypeName(Me) & ".Delete", "Invalid startIndex" 97 | ElseIf length_ < 0 Then 98 | Err.Raise 5, TypeName(Me) & ".Delete", "Invalid length_" 99 | ElseIf length_ = 0 Then 100 | Exit Sub 'Nothing to delete 101 | End If 102 | ' 103 | 'Check if a simple shift of the endIndex would suffice 104 | If startIndex + length_ > m_buffer.endIndex_ Then 105 | 'Ignoring characters that were marked for deletion 106 | m_buffer.endIndex_ = startIndex - 1 107 | Exit Sub 108 | End If 109 | ' 110 | Dim shiftLength As Long 111 | ' 112 | shiftLength = m_buffer.endIndex_ - startIndex - length_ + 1 113 | ' 114 | 'Shift Text Left 115 | Mid$(m_buffer.text_, startIndex, shiftLength) _ 116 | = VBA.Mid$(m_buffer.text_, startIndex + length_, shiftLength) 117 | ' 118 | 'Update last character position 119 | m_buffer.endIndex_ = m_buffer.endIndex_ - length_ 120 | End Sub 121 | 122 | '******************************************************************************* 123 | 'Extend buffer size if needed 124 | '******************************************************************************* 125 | Public Sub EnsureCapacity(ByVal minimumCapacity As Long) 126 | 'Maximum string length allowed by VBA for a dynamic-length string 127 | Const MAX_CAPACITY As Long = &H7FFFFFFF '2,147,483,647 (dec) 128 | ' 129 | If minimumCapacity > m_buffer.capacity_ Then 130 | Dim oldCapacity As Long: oldCapacity = m_buffer.capacity_ 131 | ' 132 | 'Avoid overflow 133 | If CDbl(minimumCapacity) * 2# > CDbl(MAX_CAPACITY) Then 134 | m_buffer.capacity_ = MAX_CAPACITY 135 | Else 136 | m_buffer.capacity_ = minimumCapacity * 2 137 | End If 138 | ' 139 | m_buffer.text_ = m_buffer.text_ & VBA.Space$(m_buffer.capacity_ - oldCapacity) 140 | End If 141 | End Sub 142 | 143 | '******************************************************************************* 144 | 'Insert new text into buffer 145 | '******************************************************************************* 146 | Public Sub Insert(ByVal startIndex As Long, ByRef textToInsert As String) 147 | 'Validate Input 148 | If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then 149 | Err.Raise 9, TypeName(Me) & ".Insert", "Invalid startIndex" 150 | End If 151 | ' 152 | Dim addedLength As Long: addedLength = VBA.Len(textToInsert) 153 | If addedLength = 0 Then Exit Sub 'Nothing to insert 154 | Dim newEndIndex As Long: newEndIndex = m_buffer.endIndex_ + addedLength 155 | Dim shiftLength As Long: shiftLength = m_buffer.endIndex_ - startIndex + 1 156 | ' 157 | 'EnsureCapacity already checks for: newEndIndex > m_buffer.capacity_ 158 | 'When many appends are done (ex. 1 character at a time for a million times) 159 | ' then the extra 'If' is faster than exiting the scope of this function 160 | ' i.e. avoid pushing a new stack frame at the top of the call stack 161 | If newEndIndex > m_buffer.capacity_ Then EnsureCapacity newEndIndex 162 | ' 163 | 'Shift Text Right 164 | Mid$(m_buffer.text_, startIndex + addedLength, shiftLength) _ 165 | = VBA.Mid$(m_buffer.text_, startIndex, shiftLength) 166 | ' 167 | 'Replace unused characters with the new text starting at startIndex 168 | 'The Mid Statement can be used to quickly replace characters 169 | 'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-statement 170 | Mid$(m_buffer.text_, startIndex, addedLength) = textToInsert 171 | ' 172 | 'Update last character position 173 | m_buffer.endIndex_ = newEndIndex 174 | End Sub 175 | 176 | '******************************************************************************* 177 | 'Replace a portion of the buffer with a given text 178 | '******************************************************************************* 179 | Public Sub Replace(ByVal startIndex As Long, ByVal length_ As Long, ByRef replacementText As String) 180 | 'Validate Input 181 | If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then 182 | Err.Raise 9, TypeName(Me) & ".Replace", "Invalid startIndex" 183 | ElseIf length_ < 0 Then 184 | Err.Raise 5, TypeName(Me) & ".Replace", "Invalid length_" 185 | ElseIf length_ = 0 Then 186 | Exit Sub 'Nothing to replace 187 | End If 188 | ' 189 | Dim usedLength As Long 190 | ' 191 | 'Compute usable length 192 | If startIndex + length_ > m_buffer.endIndex_ + 1 Then 193 | usedLength = m_buffer.endIndex_ + 1 - startIndex 194 | Else 195 | usedLength = length_ 196 | End If 197 | ' 198 | 'Replace characters with the new text 199 | 'The Mid Statement can be used to quickly replace characters 200 | 'https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-statement 201 | Mid$(m_buffer.text_, startIndex, usedLength) = replacementText 202 | End Sub 203 | 204 | '******************************************************************************* 205 | 'Reset buffer members for (re)usage 206 | '******************************************************************************* 207 | Public Sub Reset() 208 | m_buffer.text_ = vbNullString 209 | m_buffer.endIndex_ = 0 210 | m_buffer.capacity_ = 0 211 | End Sub 212 | 213 | '******************************************************************************* 214 | 'Reverses the contained string 215 | '******************************************************************************* 216 | Public Sub Reverse() 217 | If m_buffer.endIndex_ > 0 Then 218 | Me.Replace 1, m_buffer.endIndex_, VBA.StrReverse(Me.Value) 219 | End If 220 | End Sub 221 | 222 | '******************************************************************************* 223 | 'Returns a substring 224 | '******************************************************************************* 225 | Public Function Substring(ByVal startIndex As Long, ByVal length_ As Long) As String 226 | 'Validate Input 227 | If startIndex < 1 Or startIndex > m_buffer.endIndex_ Then 228 | Err.Raise 9, TypeName(Me) & ".Substring", "Invalid startIndex" 229 | ElseIf length_ < 0 Then 230 | Err.Raise 5, TypeName(Me) & ".Substring", "Invalid length_" 231 | ElseIf length_ = 0 Then 232 | Exit Function 233 | End If 234 | ' 235 | Dim usedLength As Long 236 | ' 237 | 'Compute usable length 238 | If startIndex + length_ > m_buffer.endIndex_ + 1 Then 239 | usedLength = m_buffer.endIndex_ + 1 - startIndex 240 | Else 241 | usedLength = length_ 242 | End If 243 | ' 244 | Substring = VBA.Mid$(m_buffer.text_, startIndex, usedLength) 245 | End Function 246 | 247 | '=============================================================================== 248 | 'Returns the capacity of the string i.e. total length of buffer 249 | '=============================================================================== 250 | Public Property Get Capacity() As Long 251 | Capacity = m_buffer.capacity_ 252 | End Property 253 | 254 | '=============================================================================== 255 | 'Returns the length of the string i.e. total number of used characters 256 | '=============================================================================== 257 | Public Property Get Length() As Long 258 | Length = m_buffer.endIndex_ 259 | End Property 260 | 261 | '=============================================================================== 262 | 'Get the Used String 263 | 'Default class member. 'strBuffer.Value' can be also called as 'strBuffer' 264 | 'Open class in a text editor to see: Attribute [procName].VB_UserMemId = 0 265 | '=============================================================================== 266 | Public Property Get Value() As String 267 | Attribute Value.VB_UserMemId = 0 268 | If m_buffer.endIndex_ > 0 Then 269 | Value = VBA.Left$(m_buffer.text_, m_buffer.endIndex_) 270 | End If 271 | End Property 272 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Ion Cristian Buse 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # VBA-StringBuffer 2 | 3 | StringBuffer is a VBA Class that allows faster String Append/Concatenation compared to regular VBA concatenation (by using the ```Mid``` statement) and also provides other useful methods like Insert, Delete, Replace. The naming and the structure of the methods mimic a Java-like String Buffer. 4 | 5 | ## Installation 6 | 7 | Just import the following code module in your VBA Project: 8 | 9 | * **StringBuffer.cls** 10 | 11 | ## Usage 12 | Create a new instance of the StringBuffer class and you are ready to use its methods: 13 | 14 | ```vba 15 | Dim buff As New StringBuffer 16 | ``` 17 | 18 | Example1: 19 | ```vba 20 | Sub BufferMethodsDemo() 21 | Dim buff As New StringBuffer 22 | ' 23 | buff.Append "ABFGH" 24 | Debug.Print buff.Value 'ABFGH 25 | ' 26 | buff.Insert 3, "CDE" 27 | Debug.Print buff 'ABCDEFGH 28 | ' 29 | buff.Reverse 30 | Debug.Print buff 'HGFEDCBA 31 | ' 32 | buff.Replace 2, 2, "XX" 33 | Debug.Print buff 'HXXEDCBA 34 | ' 35 | buff.Reverse 36 | Debug.Print buff 'ABCDEXXH 37 | ' 38 | buff.Delete 6, 2 39 | Debug.Print buff 'ABCDEH 40 | ' 41 | Debug.Print buff.Substring(2, 3) 'BCD 42 | End Sub 43 | ``` 44 | 45 | Example2 (see DEMO_General Module for full code): 46 | ```vba 47 | Public Function TabDelimitedTextFrom2DArray(arr As Variant) As String 48 | Const methodName As String = "TabDelimitedTextFrom2DArray" 49 | ' 50 | If GetDimensionsCount(arr) <> 2 Then 51 | Err.Raise 5, MODULE_NAME & "." & methodName, "Expected 2D Array" 52 | End If 53 | ' 54 | Dim i As Long 55 | Dim j As Long 56 | Dim lowerRowBound As Long: lowerRowBound = LBound(arr, 1) 57 | Dim upperRowBound As Long: upperRowBound = UBound(arr, 1) 58 | Dim lowerColBound As Long: lowerColBound = LBound(arr, 2) 59 | Dim upperColBound As Long: upperColBound = UBound(arr, 2) 60 | Dim buff As New StringBuffer 61 | ' 62 | On Error GoTo ErrorHandler 63 | For i = lowerRowBound To upperRowBound 64 | For j = lowerColBound To upperColBound 65 | If IsNull(arr(i, j)) Then 66 | buff.Append "NULL" 67 | Else 68 | buff.Append CStr(arr(i, j)) 69 | End If 70 | If j < upperColBound Then buff.Append vbTab 71 | Next j 72 | If i < upperRowBound Then buff.Append vbNewLine 73 | Next i 74 | ' 75 | TabDelimitedTextFrom2DArray = buff.StringValue 76 | Exit Function 77 | ErrorHandler: 78 | Err.Raise Err.Number, MODULE_NAME & "." & methodName, "Invalid Array Value" 79 | End Function 80 | ``` 81 | 82 | ## Notes 83 | * The StringBuffer is extremely useful for operations that involve lots of append operations. For example, it can append 1 character at a time for a million times in about 15 milliseconds on a Windows OS. 84 | * You can download the available Demo Workbook. There is a Worksheet that allows you to test the Append speed and also another Worksheet with a few saved speed results for comparison. 85 | 86 | ## License 87 | MIT License 88 | 89 | Copyright (c) 2019 Ion Cristian Buse 90 | 91 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 92 | 93 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 94 | 95 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. -------------------------------------------------------------------------------- /VBA StringBuffer_Demo.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/cristianbuse/VBA-StringBuffer/c727796f7b85b1b61f5a7a39f7b98388aa1ee878/VBA StringBuffer_Demo.xlsm --------------------------------------------------------------------------------