Hello World
Hello World
") -> "<p>Hello World</p>" 180 | 181 | HtmlEscapeTest = True 182 | 183 | HtmlEscapeTest = HtmlEscapeTest And HtmlEscape("Hello World
") = "<p>Hello World</p>" 184 | 185 | End Function 186 | 187 | 188 | Private Function HtmlUnescapeTest() As Boolean 189 | 190 | '@Example: =HtmlUnescape("<p>Hello World</p>") -> "Hello World
" 191 | 192 | HtmlUnescapeTest = True 193 | 194 | HtmlUnescapeTest = HtmlUnescapeTest And HtmlUnescape("<p>Hello World</p>") = "Hello World
" 195 | 196 | End Function 197 | 198 | 199 | Private Function SpeakTextTest() As Boolean 200 | 201 | '@Example: =SpeakText("Hello", "World") -> "Hello World" and the text will be spoken through the speaker 202 | 203 | SpeakTextTest = True 204 | 205 | SpeakTextTest = SpeakTextTest And SpeakText("Hello", "World") = "Hello World" 206 | 207 | End Function 208 | 209 | 210 | Private Function Dec2HexTest() As Boolean 211 | 212 | '@Example: =Dec2Hex(5) -> "5" 213 | '@Example: =Dec2Hex(5, 2) -> "05" 214 | '@Example: =Dec2Hex(255, 2) -> "FF" 215 | '@Example: =Dec2Hex(255, 8) -> "000000FF" 216 | 217 | Dec2HexTest = True 218 | 219 | Dec2HexTest = Dec2HexTest And Dec2Hex(5) = "5" 220 | Dec2HexTest = Dec2HexTest And Dec2Hex(5, 2) = "05" 221 | Dec2HexTest = Dec2HexTest And Dec2Hex(255, 2) = "FF" 222 | Dec2HexTest = Dec2HexTest And Dec2Hex(255, 8) = "000000FF" 223 | 224 | End Function 225 | 226 | 227 | Private Function BigDec2HexTest() As Boolean 228 | 229 | '@Example: =Dec2Hex(255, 8) -> "000000FF" 230 | '@Example: =Dec2Hex(3000000000, 16) -> Error; As Dec2Hex does not support integers this large 231 | '@Example: =BigDec2Hex(3000000000, 16) -> "00000000B2D05E00" 232 | 233 | BigDec2HexTest = True 234 | 235 | BigDec2HexTest = BigDec2HexTest And BigDec2Hex(3000000000#, 16) = "00000000B2D05E00" 236 | 237 | End Function 238 | 239 | 240 | Private Function BigHexTest() As Boolean 241 | 242 | '@Example: =BigHex(255) -> "FF" 243 | '@Example: =Hex(3000000000) -> Error; As hex does not support big integers 244 | '@Example: =BigHex(3000000000) -> "B2D05E00" 245 | 246 | BigHexTest = True 247 | 248 | BigHexTest = BigHexTest And BigHex(3000000000#) = "B2D05E00" 249 | 250 | End Function 251 | 252 | 253 | Private Function Hex2DecTest() As Boolean 254 | 255 | '@Example: =Hex2Dec("FF") -> 255 256 | '@Example: =Hex2Dec("FFFF") -> 65535 257 | 258 | Hex2DecTest = True 259 | 260 | Hex2DecTest = Hex2DecTest And Hex2Dec("FF") = 255 261 | Hex2DecTest = Hex2DecTest And Hex2Dec("FFFF") = 65535 262 | 263 | End Function 264 | 265 | 266 | Private Function Len2Test() As Boolean 267 | 268 | '@Example: =Len2("Hello") -> 5; As the string is 5 characters long 269 | '@Example: =Len2(arr) -> 3; Where arr is an array with {1, 2, 3} in it, and the array has 3 values in it 270 | '@Example: =Len2("100") -> 3; As the string is 3 characters long 271 | '@Example: =Len2(100) -> 3; As the integer is 3 characters long when converted to a string 272 | '@Example: =Len2(Range("A1:A3")) -> 3; As the Excel Range has 3 273 | '@Example: =Len2(col) -> 5; Where col is a Collection with 5 items in it 274 | '@Example: =Len2(dict) -> 2; Where dict is a Dictionary with 2 key/value pairs in it 275 | '@Example: =Len2(Application.Documents) -> 3; Where we currently have 3 documents open 276 | '@Example: =Len2(Application.ActivePresentation.Slides) -> 10; Where the active PowerPoint Presentation has 10 slides 277 | 278 | Len2Test = True 279 | 280 | Len2Test = Len2Test And Len2("Hello") = 5 281 | Len2Test = Len2Test And Len2(Array(1, 2, 3)) = 3 282 | Len2Test = Len2Test And Len2("100") = 3 283 | Len2Test = Len2Test And Len2(100) = 3 284 | 285 | Dim col As Collection 286 | Set col = New Collection 287 | col.Add 1 288 | col.Add 2 289 | col.Add 3 290 | col.Add 4 291 | col.Add 5 292 | Len2Test = Len2Test And Len2(col) = 5 293 | 294 | Dim dict As Object 295 | Set dict = CreateObject("Scripting.Dictionary") 296 | dict.Add "Hello", 1 297 | dict.Add "World", 2 298 | Len2Test = Len2Test And Len2(dict) = 2 299 | 300 | End Function 301 | 302 | -------------------------------------------------------------------------------- /Modules/xlibStringMetrics.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "xlibStringMetrics" 2 | '@Module: This module contains a set of functions for performing fuzzy string matches. It can be useful when you have 2 columns containing text that is close but not 100% the same. However, since the functions in this module only perform fuzzy matches, there is no guarantee that there will be 100% accuracy in the matches. However, for small groups of string where each string is very different than the other (such as a small group of fairly dissimilar names), these functions can be highly accurate. Finally, some of the functions in this Module will take a long time to calculate for large numbers of cells, as the number of calculations for some functions will grow exponentially, but for small sets of data (such as 100 strings to compare), these functions perform fairly quickly. 3 | 4 | Option Explicit 5 | 6 | 7 | '======================================== 8 | ' Hamming Distance 9 | '======================================== 10 | 11 | Public Function Hamming( _ 12 | string1 As String, _ 13 | string2 As String) _ 14 | As Integer 15 | 16 | '@Description: This function takes two strings of the same length and calculates the Hamming Distance between them. Hamming Distance measures how close two strings are by checking how many Substitutions are needed to turn one string into the other. Lower numbers mean the strings are closer than high numbers. 17 | '@Author: Anthony Mancini 18 | '@Version: 1.0.0 19 | '@License: MIT 20 | '@Param: string1 is the first string 21 | '@Param: string2 is the second string that will be compared to the first string 22 | '@Returns: Returns an integer of the Hamming Distance between two string 23 | '@Example: =Hamming("Cat", "Bat") -> 1; Since all that is needed is 1 change (changing the "B" in Bat to "C") 24 | '@Example: =Hamming("Cat", "Bag") -> 2; 2 changes are needed, changing the "B" to "C" and the "g" to "t" 25 | '@Example: =Hamming("Cat", "Dog") -> 3; Every single character needs to be substituted in this case 26 | 27 | If Len(string1) <> Len(string2) Then 28 | Hamming = CVErr(2015) 29 | End If 30 | 31 | Dim totalDistance As Integer 32 | totalDistance = 0 33 | 34 | Dim i As Integer 35 | 36 | For i = 1 To Len(string1) 37 | If Mid(string1, i, 1) <> Mid(string2, i, 1) Then 38 | totalDistance = totalDistance + 1 39 | End If 40 | Next 41 | 42 | Hamming = totalDistance 43 | 44 | End Function 45 | 46 | 47 | 48 | '======================================== 49 | ' Levenshtein Distance 50 | '======================================== 51 | 52 | Public Function Levenshtein( _ 53 | string1 As String, _ 54 | string2 As String) _ 55 | As Long 56 | 57 | '@Description: This function takes two strings of any length and calculates the Levenshtein Distance between them. Levenshtein Distance measures how close two strings are by checking how many Insertions, Deletions, or Substitutions are needed to turn one string into the other. Lower numbers mean the strings are closer than high numbers. Unlike Hamming Distance, Levenshtein Distance works for strings of any length and includes 2 more operations. However, calculation time will be slower than Hamming Distance for same length strings, so if you know the two strings are the same length, its preferred to use Hamming Distance. 58 | '@Author: Anthony Mancini 59 | '@Version: 1.1.0 60 | '@License: MIT 61 | '@Param: string1 is the first string 62 | '@Param: string2 is the second string that will be compared to the first string 63 | '@Returns: Returns an integer of the Levenshtein Distance between two string 64 | '@Example: =Levenshtein("Cat", "Bat") -> 1; Since all that is needed is 1 change (changing the "B" in Bat to "C") 65 | '@Example: =Levenshtein("Cat", "Ca") -> 1; Since only one Insertion needs to occur (adding a "t" at the end) 66 | '@Example: =Levenshtein("Cat", "Cta") -> 2; Since the "t" in "Cta" needs to be substituted into an "a", and the final character "a" needs to be substituted into a "t" 67 | 68 | ' **Error Checking** 69 | ' Quick returns for common errors 70 | If string1 = string2 Then 71 | Levenshtein = 0 72 | Exit Function 73 | ElseIf string1 = Empty Then 74 | Levenshtein = Len(string2) 75 | Exit Function 76 | ElseIf string2 = Empty Then 77 | Levenshtein = Len(string1) 78 | Exit Function 79 | End If 80 | 81 | 82 | ' **Algorithm Code** 83 | ' Creating the distance metrix and filling it with values 84 | Dim numberOfRows As Integer 85 | Dim numberOfColumns As Integer 86 | 87 | numberOfRows = Len(string1) 88 | numberOfColumns = Len(string2) 89 | 90 | Dim distanceArray() As Integer 91 | ReDim distanceArray(numberOfRows, numberOfColumns) 92 | 93 | Dim r As Integer 94 | Dim c As Integer 95 | 96 | For r = 0 To numberOfRows 97 | For c = 0 To numberOfColumns 98 | distanceArray(r, c) = 0 99 | Next 100 | Next 101 | 102 | For r = 1 To numberOfRows 103 | distanceArray(r, 0) = r 104 | Next 105 | 106 | For c = 1 To numberOfColumns 107 | distanceArray(0, c) = c 108 | Next 109 | 110 | ' Non-recursive Levenshtein Distance matrix walk 111 | Dim operationCost As Integer 112 | 113 | For c = 1 To numberOfColumns 114 | For r = 1 To numberOfRows 115 | If Mid(string1, r, 1) = Mid(string2, c, 1) Then 116 | operationCost = 0 117 | Else 118 | operationCost = 1 119 | End If 120 | 121 | distanceArray(r, c) = Min(distanceArray(r - 1, c) + 1, distanceArray(r, c - 1) + 1, distanceArray(r - 1, c - 1) + operationCost) 122 | Next 123 | Next 124 | 125 | Levenshtein = distanceArray(numberOfRows, numberOfColumns) 126 | 127 | End Function 128 | 129 | 130 | 131 | '======================================== 132 | ' Damerau-Levenshtein Distance 133 | '======================================== 134 | 135 | Public Function Damerau( _ 136 | string1 As String, _ 137 | string2 As String) _ 138 | As Integer 139 | 140 | '@Description: This function takes two strings of any length and calculates the Damerau-Levenshtein Distance between them. Damerau-Levenshtein Distance differs from Levenshtein Distance in that it includes an additional operation, called Transpositions, which occurs when two adjacent characters are swapped. Thus, Damerau-Levenshtein Distance calculates the number of Insertions, Deletions, Substitutions, and Transpositons needed to convert string1 into string2. As a result, this function is good when it is likely that spelling errors have occured between two string where the error is simply a transposition of 2 adjacent characters. 141 | '@Author: Anthony Mancini 142 | '@Version: 1.1.0 143 | '@License: MIT 144 | '@Param: string1 is the first string 145 | '@Param: string2 is the second string that will be compared to the first string 146 | '@Returns: Returns an integer of the Damerau-Levenshtein Distance between two string 147 | '@Example: =Damerau("Cat", "Bat") -> 1; Since all that is needed is 1 change (changing the "B" in Bat to "C") 148 | '@Example: =Damerau("Cat", "Ca") -> 1; Since only one Insertion needs to occur (adding a "t" at the end) 149 | '@Example: =Damerau("Cat", "Cta") -> 1; Since the "t" and "a" can be transposed as they are adjacent to each other. Notice how LEVENSHTEIN("Cat","Cta")=2 but DAMERAU("Cat","Cta")=1 150 | 151 | ' **Error Checking** 152 | ' Quick returns for common errors 153 | If string1 = string2 Then 154 | Damerau = 0 155 | ElseIf string1 = Empty Then 156 | Damerau = Len(string2) 157 | ElseIf string2 = Empty Then 158 | Damerau = Len(string1) 159 | End If 160 | 161 | Dim inf As Long 162 | Dim da As Object 163 | inf = Len(string1) + Len(string2) 164 | Set da = CreateObject("Scripting.Dictionary") 165 | 166 | ' 35 - 38 = filling the dictionary 167 | Dim i As Integer 168 | For i = 1 To Len(string1) 169 | If da.exists(Mid(string1, i, 1)) = False Then 170 | da.Add Mid(string1, i, 1), "0" 171 | End If 172 | Next 173 | 174 | For i = 1 To Len(string2) 175 | If da.exists(Mid(string2, i, 1)) = False Then 176 | da.Add Mid(string2, i, 1), "0" 177 | End If 178 | Next 179 | 180 | ' 39 = creating h matrix 181 | Dim H() As Long 182 | ReDim H(Len(string1) + 1, Len(string2) + 1) 183 | 184 | Dim k As Integer 185 | For i = 0 To (Len(string1) + 1) 186 | For k = 0 To (Len(string2) + 1) 187 | H(i, k) = 0 188 | Next 189 | Next 190 | 191 | ' 40 - 45 = updating the matrix 192 | For i = 0 To Len(string1) 193 | H(i + 1, 0) = inf 194 | H(i + 1, 1) = i 195 | Next 196 | For k = 0 To Len(string2) 197 | H(0, k + 1) = inf 198 | H(1, k + 1) = k 199 | Next 200 | 201 | 202 | ' 46 - 60 = running the array 203 | Dim db As Long 204 | Dim i1 As Long 205 | Dim k1 As Long 206 | Dim cost As Long 207 | 208 | For i = 1 To Len(string1) 209 | db = 0 210 | For k = 1 To Len(string2) 211 | i1 = CInt(da(Mid(string2, k, 1))) 212 | k1 = db 213 | cost = 1 214 | 215 | If Mid(string1, i, 1) = Mid(string2, k, 1) Then 216 | cost = 0 217 | db = k 218 | End If 219 | 220 | H(i + 1, k + 1) = Min(H(i, k) + cost, _ 221 | H(i + 1, k) + 1, _ 222 | H(i, k + 1) + 1, _ 223 | H(i1, k1) + (i - i1 - 1) + 1 + (k - k1 - 1)) 224 | 225 | 226 | Next 227 | 228 | If da.exists(Mid(string1, i, 1)) Then 229 | da.Remove Mid(string1, i, 1) 230 | da.Add Mid(string1, i, 1), CStr(i) 231 | Else 232 | da.Add Mid(string1, i, 1), CStr(i) 233 | End If 234 | 235 | Next 236 | 237 | Damerau = H(Len(string1) + 1, Len(string2) + 1) 238 | 239 | End Function 240 | 241 | -------------------------------------------------------------------------------- /Modules/xlibDateTime.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "xlibDateTime" 2 | '@Module: This module contains a set of functions for working with dates and times. 3 | 4 | Option Private Module 5 | Option Explicit 6 | 7 | 8 | Public Function WeekdayName2( _ 9 | Optional ByVal dayNumber As Byte) _ 10 | As String 11 | 12 | '@Description: This function takes a weekday number and returns the name of the day of the week. 13 | '@Author: Anthony Mancini 14 | '@Version: 1.0.0 15 | '@License: MIT 16 | '@Param: dayNumber is a number that should be between 1 and 7, with 1 being Sunday and 7 being Saturday. If no dayNumber is given, the value will default to the current day of the week. 17 | '@Returns: Returns the day of the week as a string 18 | '@Example: =WeekdayName2(4) -> Wednesday 19 | '@Example: To get today's weekday name: =WeekdayName2() 20 | 21 | If dayNumber = 0 Then 22 | WeekdayName2 = WeekdayName(Weekday(Now())) 23 | Else 24 | WeekdayName2 = WeekdayName(dayNumber) 25 | End If 26 | 27 | End Function 28 | 29 | 30 | Public Function MonthName2( _ 31 | Optional ByVal monthNumber As Byte) _ 32 | As String 33 | 34 | '@Description: This function takes a month number and returns the name of the month. 35 | '@Author: Anthony Mancini 36 | '@Version: 1.0.0 37 | '@License: MIT 38 | '@Param: monthNumber is a number that should be between 1 and 12, with 1 being January and 12 being December. If no monthNumber is given, the value will default to the current month. 39 | '@Returns: Returns the month name as a string 40 | '@Example: =MonthName2(1) -> "January" 41 | '@Example: =MonthName2(3) -> "March" 42 | '@Example: To get today's month name: =MonthName2() 43 | 44 | If monthNumber = 0 Then 45 | MonthName2 = MonthName(Month(Now())) 46 | Else 47 | MonthName2 = MonthName(monthNumber) 48 | End If 49 | 50 | End Function 51 | 52 | 53 | Public Function Quarter( _ 54 | Optional ByVal monthNumberOrName As Variant) _ 55 | As Byte 56 | 57 | '@Description: This function takes a month as a number and returns the Quarter of the year the month resides. 58 | '@Author: Anthony Mancini 59 | '@Version: 1.0.0 60 | '@License: MIT 61 | '@Todo: Look further into DatePart function and see if its a better choice for generating the Quarter of the year. Also look into adding the month name as well as an option for this function 62 | '@Param: monthNumberOrName is a number that should be between 1 and 12, with 1 being January and 12 being December, or the name of a Month, such as "January" or "March". 63 | '@Returns: Returns the Quarter of the month as a number 64 | '@Example: =Quarter(4) -> 2 65 | '@Example: =Quarter("April") -> 2 66 | '@Example: =Quarter(12) -> 4 67 | '@Example: =Quarter("December") -> 4 68 | '@Example: To get today's Quarter: =Quarter() 69 | 70 | If IsMissing(monthNumberOrName) Then 71 | monthNumberOrName = MonthName(Month(Now())) 72 | End If 73 | 74 | If IsNumeric(monthNumberOrName) Then 75 | monthNumberOrName = MonthName(monthNumberOrName) 76 | End If 77 | 78 | 79 | If monthNumberOrName = MonthName(1) Or monthNumberOrName = MonthName(2) Or monthNumberOrName = MonthName(3) Then 80 | Quarter = 1 81 | End If 82 | 83 | If monthNumberOrName = MonthName(4) Or monthNumberOrName = MonthName(5) Or monthNumberOrName = MonthName(6) Then 84 | Quarter = 2 85 | End If 86 | 87 | If monthNumberOrName = MonthName(7) Or monthNumberOrName = MonthName(8) Or monthNumberOrName = MonthName(9) Then 88 | Quarter = 3 89 | End If 90 | 91 | If monthNumberOrName = MonthName(10) Or monthNumberOrName = MonthName(11) Or monthNumberOrName = MonthName(12) Then 92 | Quarter = 4 93 | End If 94 | 95 | End Function 96 | 97 | 98 | Public Function TimeConverter( _ 99 | ByVal date1 As Date, _ 100 | Optional ByVal secondsInteger As Integer, _ 101 | Optional ByVal minutesInteger As Integer, _ 102 | Optional ByVal hoursInteger As Integer, _ 103 | Optional ByVal daysInteger As Integer, _ 104 | Optional ByVal monthsInteger As Integer, _ 105 | Optional ByVal yearsInteger As Integer) _ 106 | As Date 107 | 108 | '@Description: This function takes a date, and then a series of optional arguments for a number of seconds, minutes, hours, days, and years, and then converts the date given to a new date adding in the other date argument values. 109 | '@Author: Anthony Mancini 110 | '@Version: 1.0.0 111 | '@License: MIT 112 | '@Param: date1 is the original date that will be converted into a new date 113 | '@Param: secondsInteger is the number of seconds that will be added 114 | '@Param: minutesInteger is the number of minutes that will be added 115 | '@Param: hoursInteger is the number of hours that will be added 116 | '@Param: daysInteger is the number of days that will be added 117 | '@Param: monthsInteger is the number of months that will be added 118 | '@Param: yearsInteger is the number of years that will be added 119 | '@Returns: Returns a new date with all the date arguments added to it 120 | '@Note: You can skip earlier date arguments in the function by putting a 0 in place. For example, if we only wanted to change the month, which is the 5th argument, we can do =TimeConverter(A1,0,0,0,2) which will add 2 months to the date chosen 121 | '@Example: =TimeConverter(A1,60) -> 1/1/2000 1:01; Where A1 contains the date 1/1/2000 1:00 122 | '@Example: =TimeConverter(A1,0,5) -> 1/1/2000 1:05; Where A1 contains the date 1/1/2000 1:00 123 | '@Example: =TimeConverter(A1,0,0,2) -> 1/1/2000 3:00; Where A1 contains the date 1/1/2000 1:00 124 | '@Example: =TimeConverter(A1,0,0,0,4) -> 1/5/2000 1:00; Where A1 contains the date 1/1/2000 1:00 125 | '@Example: =TimeConverter(A1,0,0,0,0,1) -> 2/1/2000 1:00; Where A1 contains the date 1/1/2000 1:00 126 | '@Example: =TimeConverter(A1,0,0,0,0,0,5) -> 1/1/2005 1:00; Where A1 contains the date 1/1/2000 1:00 127 | '@Example: =TimeConverter(A1,60,5,3,10,5,15) -> 6/11/2015 4:06; Where A1 contains the date 1/1/2000 1:00 128 | 129 | secondsInteger = Second(date1) + secondsInteger 130 | minutesInteger = Minute(date1) + minutesInteger 131 | hoursInteger = Hour(date1) + hoursInteger 132 | daysInteger = Day(date1) + daysInteger 133 | monthsInteger = Month(date1) + monthsInteger 134 | yearsInteger = Year(date1) + yearsInteger 135 | 136 | TimeConverter = DateSerial(yearsInteger, monthsInteger, daysInteger) + TimeSerial(hoursInteger, minutesInteger, secondsInteger) 137 | 138 | End Function 139 | 140 | 141 | Public Function DaysOfMonth( _ 142 | Optional ByVal monthNumberOrName As Variant, _ 143 | Optional ByVal yearNumber As Integer) _ 144 | As Variant 145 | 146 | '@Description: This function takes a month number or month name and returns the number of days in the month. Optionally, a year number can be specified. If no year number is provided, the current year will be used. Finally, note that the month name or number argument is optional and if omitted will use the current month. 147 | '@Author: Anthony Mancini 148 | '@Version: 1.0.0 149 | '@License: MIT 150 | '@Param: monthNumberOrName is a number that should be between 1 and 12, with 1 being January and 12 being December, or the name of a Month, such as "January" or "March". If omitted the current month will be used. 151 | '@Param: yearNumber is the year that will be used. If omitted, the current year will be used. 152 | '@Returns: Returns the number of days in the month and year specified 153 | '@Example: =DaysOfMonth() -> 31; Where the current month is January 154 | '@Example: =DaysOfMonth(1) -> 31 155 | '@Example: =DaysOfMonth("January") -> 31 156 | '@Example: =DaysOfMonth(2, 2019) -> 28 157 | '@Example: =DaysOfMonth(2, 2020) -> 29 158 | 159 | If IsMissing(monthNumberOrName) Then 160 | monthNumberOrName = Month(Now()) 161 | End If 162 | 163 | If yearNumber = 0 Then 164 | yearNumber = Year(Now()) 165 | End If 166 | 167 | If monthNumberOrName = 1 Or monthNumberOrName = MonthName(1) Then 168 | DaysOfMonth = 31 169 | ElseIf monthNumberOrName = 2 Or monthNumberOrName = MonthName(2) Then 170 | If yearNumber Mod 4 <> 0 Then 171 | DaysOfMonth = 28 172 | Else 173 | DaysOfMonth = 29 174 | End If 175 | ElseIf monthNumberOrName = 3 Or monthNumberOrName = MonthName(3) Then 176 | DaysOfMonth = 31 177 | ElseIf monthNumberOrName = 4 Or monthNumberOrName = MonthName(4) Then 178 | DaysOfMonth = 30 179 | ElseIf monthNumberOrName = 5 Or monthNumberOrName = MonthName(5) Then 180 | DaysOfMonth = 31 181 | ElseIf monthNumberOrName = 6 Or monthNumberOrName = MonthName(6) Then 182 | DaysOfMonth = 30 183 | ElseIf monthNumberOrName = 7 Or monthNumberOrName = MonthName(7) Then 184 | DaysOfMonth = 31 185 | ElseIf monthNumberOrName = 8 Or monthNumberOrName = MonthName(8) Then 186 | DaysOfMonth = 31 187 | ElseIf monthNumberOrName = 9 Or monthNumberOrName = MonthName(9) Then 188 | DaysOfMonth = 30 189 | ElseIf monthNumberOrName = 10 Or monthNumberOrName = MonthName(10) Then 190 | DaysOfMonth = 31 191 | ElseIf monthNumberOrName = 11 Or monthNumberOrName = MonthName(11) Then 192 | DaysOfMonth = 30 193 | ElseIf monthNumberOrName = 12 Or monthNumberOrName = MonthName(12) Then 194 | DaysOfMonth = 31 195 | Else 196 | DaysOfMonth = "#NotAValidMonthNumberOrName" 197 | End If 198 | 199 | End Function 200 | 201 | 202 | Public Function WeekOfMonth( _ 203 | Optional ByVal date1 As Date) _ 204 | As Byte 205 | 206 | '@Description: This function takes a date and returns the number of the week of the month for that date. If no date is given, the current date is used. 207 | '@Author: Anthony Mancini 208 | '@Version: 1.0.0 209 | '@License: MIT 210 | '@Param: date1 is a date whose week number will be found 211 | '@Returns: Returns the number of week in the month 212 | '@Example: =WeekOfMonth() -> 5; Where the current date is 1/29/2020 213 | '@Example: =WeekOfMonth(1/29/2020) -> 5 214 | '@Example: =WeekOfMonth(1/28/2020) -> 5 215 | '@Example: =WeekOfMonth(1/27/2020) -> 5 216 | '@Example: =WeekOfMonth(1/26/2020) -> 5 217 | '@Example: =WeekOfMonth(1/25/2020) -> 4 218 | '@Example: =WeekOfMonth(1/24/2020) -> 4 219 | '@Example: =WeekOfMonth(1/1/2020) -> 1 220 | 221 | 222 | Dim weekNumber As Byte 223 | Dim currentDay As Byte 224 | Dim currentWeekday As Byte 225 | 226 | weekNumber = 1 227 | 228 | ' When year is 1899, no year was given as an input 229 | If Year(date1) = 1899 Then 230 | currentDay = Day(Now()) 231 | currentWeekday = Weekday(Now()) 232 | Else 233 | currentDay = Day(date1) 234 | currentWeekday = Weekday(date1) 235 | End If 236 | 237 | While currentDay <> 0 238 | If currentWeekday = 0 Then 239 | weekNumber = weekNumber + 1 240 | currentWeekday = 7 241 | End If 242 | 243 | currentDay = currentDay - 1 244 | currentWeekday = currentWeekday - 1 245 | Wend 246 | 247 | WeekOfMonth = weekNumber 248 | 249 | End Function 250 | -------------------------------------------------------------------------------- /Modules/xlibArray.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "xlibArray" 2 | '@Module: This module contains a set of functions for manipulating and working with arrays. 3 | 4 | Option Explicit 5 | 6 | 7 | Public Function CountUnique( _ 8 | ParamArray array1() As Variant) _ 9 | As Integer 10 | 11 | '@Description: This function counts the number of unique occurances of values within a range or multiple ranges 12 | '@Author: Anthony Mancini 13 | '@Version: 1.0.0 14 | '@License: MIT 15 | '@Param: array1 is the group of cells we are counting the unique values of 16 | '@Returns: Returns the number of unique values 17 | '@Example: =CountUnique(1, 2, 2, 3) -> 3; 18 | '@Example: =CountUnique("a", "a", "a") -> 1; 19 | '@Example: =CountUnique(arr) -> 3; Where arr = [1, 2, 4, 4, 1] 20 | 21 | Dim individualElement As Variant 22 | Dim individualValue As Variant 23 | Dim uniqueDictionary As Object 24 | Dim uniqueCount As Integer 25 | 26 | Set uniqueDictionary = CreateObject("Scripting.Dictionary") 27 | 28 | For Each individualElement In array1 29 | If IsArray(individualElement) Then 30 | For Each individualValue In individualElement 31 | If Not uniqueDictionary.exists(individualValue) Then 32 | uniqueDictionary.Add individualValue, 0 33 | uniqueCount = uniqueCount + 1 34 | End If 35 | Next 36 | Else 37 | If Not uniqueDictionary.exists(individualElement) Then 38 | uniqueDictionary.Add individualElement, 0 39 | uniqueCount = uniqueCount + 1 40 | End If 41 | End If 42 | Next 43 | 44 | CountUnique = uniqueCount 45 | 46 | End Function 47 | 48 | 49 | Public Function Sort( _ 50 | ByVal sortableArray As Variant, _ 51 | Optional ByVal descendingFlag As Boolean) _ 52 | As Variant 53 | 54 | '@Description: This function is an implementation of Bubble Sort, allowing the user to sort an array, optionally allowing the user to specify the array to be sorted in descending order 55 | '@Author: Anthony Mancini 56 | '@Version: 1.0.0 57 | '@License: MIT 58 | '@Param: sortableArray is the array that will be sorted 59 | '@Param: descendingFlag changes the sort to descending 60 | '@Returns: Returns the a sorted array 61 | '@Example: =Sort({1,3,2}) -> {1,2,3} 62 | '@Example: =Sort({1,3,2}, True) -> {3,2,1} 63 | 64 | Dim i As Integer 65 | Dim swapOccuredBool As Boolean 66 | Dim arrayLength As Integer 67 | arrayLength = UBound(sortableArray) - LBound(sortableArray) + 1 68 | 69 | Dim sortedArray() As Variant 70 | ReDim sortedArray(arrayLength) 71 | 72 | For i = 0 To arrayLength - 1 73 | sortedArray(i) = sortableArray(i) 74 | Next 75 | 76 | Dim temporaryValue As Variant 77 | 78 | Do 79 | swapOccuredBool = False 80 | For i = 0 To arrayLength - 1 81 | If (sortedArray(i)) < sortedArray(i + 1) Then 82 | temporaryValue = sortedArray(i) 83 | sortedArray(i) = sortedArray(i + 1) 84 | sortedArray(i + 1) = temporaryValue 85 | swapOccuredBool = True 86 | End If 87 | Next 88 | Loop While swapOccuredBool 89 | 90 | If descendingFlag = True Then 91 | Sort = sortedArray 92 | Else 93 | Dim ascendingArray() As Variant 94 | ReDim ascendingArray(arrayLength) 95 | 96 | For i = 0 To arrayLength - 1 97 | ascendingArray(i) = sortedArray(arrayLength - i - 1) 98 | Next 99 | 100 | Sort = ascendingArray 101 | End If 102 | 103 | End Function 104 | 105 | 106 | Public Function Reverse( _ 107 | ByVal array1 As Variant) _ 108 | As Variant 109 | 110 | '@Description: This function takes an array and reverses all its elements 111 | '@Author: Anthony Mancini 112 | '@Version: 1.0.0 113 | '@License: MIT 114 | '@Param: array1 is the array that will be reversed 115 | '@Returns: Returns the a reversed array 116 | '@Example: =Reverse({1,2,3}) -> {3,2,1} 117 | 118 | Dim i As Integer 119 | Dim arrayLength As Integer 120 | Dim reversedArray() As Variant 121 | 122 | arrayLength = UBound(array1) - LBound(array1) 123 | ReDim reversedArray(arrayLength) 124 | 125 | For i = LBound(array1) To UBound(array1) 126 | reversedArray(arrayLength - i) = array1(i) 127 | Next 128 | 129 | Reverse = reversedArray 130 | 131 | End Function 132 | 133 | 134 | Public Function SumHigh( _ 135 | ByVal array1 As Variant, _ 136 | ByVal numberSummed As Integer) _ 137 | As Variant 138 | 139 | '@Description: This function returns the sum of the top values of the number specified in the second argument. For example, if the second argument is 3, only the top 3 values will be summed 140 | '@Author: Anthony Mancini 141 | '@Version: 1.0.0 142 | '@License: MIT 143 | '@Param: array1 is the range that will be summed 144 | '@Param: numberSummed is the number of the top values that will be summed 145 | '@Returns: Returns the sum of the top numbers specified 146 | '@Example: =SumHigh({1,2,3,4}, 2) -> 7; as 3 and 4 will be summed 147 | '@Example: =SumHigh({1,2,3,4}, 3) -> 9; as 2, 3, and 4 will be summed 148 | 149 | Dim i As Integer 150 | Dim sumValue As Double 151 | 152 | For i = 1 To numberSummed 153 | sumValue = sumValue + Large(array1, i) 154 | Next 155 | 156 | SumHigh = sumValue 157 | 158 | End Function 159 | 160 | 161 | Public Function SumLow( _ 162 | ByVal array1 As Variant, _ 163 | ByVal numberSummed As Integer) _ 164 | As Variant 165 | 166 | '@Description: This function returns the sum of the bottom values of the number specified in the second argument. For example, if the second argument is 3, only the bottom 3 values will be summed 167 | '@Author: Anthony Mancini 168 | '@Version: 1.0.0 169 | '@License: MIT 170 | '@Param: array1 is the range that will be summed 171 | '@Param: numberSummed is the number of the bottom values that will be summed 172 | '@Returns: Returns the sum of the bottom numbers specified 173 | '@Example: =SumLow({1,2,3,4}, 2) -> 3; as 1 and 2 will be summed 174 | '@Example: =SumLow({1,2,3,4}, 3) -> 6; as 1, 2, and 3 will be summed 175 | 176 | Dim i As Integer 177 | Dim sumValue As Double 178 | 179 | For i = 1 To numberSummed 180 | sumValue = sumValue + Small(array1, i) 181 | Next 182 | 183 | SumLow = sumValue 184 | 185 | End Function 186 | 187 | 188 | Public Function AverageHigh( _ 189 | ByVal array1 As Variant, _ 190 | ByVal numberAveraged As Integer) _ 191 | As Variant 192 | 193 | '@Description: This function returns the average of the top values of the number specified in the second argument. For example, if the second argument is 3, only the top 3 values will be averaged 194 | '@Author: Anthony Mancini 195 | '@Version: 1.0.0 196 | '@License: MIT 197 | '@Param: array1 is the range that will be averaged 198 | '@Param: numberAveraged is the number of the top values that will be averaged 199 | '@Returns: Returns the average of the top numbers specified 200 | '@Example: =AverageHigh({1,2,3,4}, 2) -> 3.5; as 3 and 4 will be averaged 201 | '@Example: =AverageHigh({1,2,3,4}, 3) -> 3; as 2, 3, and 4 will be averaged 202 | 203 | Dim i As Integer 204 | Dim sumValue As Double 205 | 206 | For i = 1 To numberAveraged 207 | sumValue = sumValue + Large(array1, i) 208 | Next 209 | 210 | AverageHigh = sumValue / numberAveraged 211 | 212 | End Function 213 | 214 | 215 | Public Function AverageLow( _ 216 | ByVal array1 As Variant, _ 217 | ByVal numberAveraged As Integer) _ 218 | As Variant 219 | 220 | '@Description: This function returns the average of the bottom values of the number specified in the second argument. For example, if the second argument is 3, only the bottom 3 values will be averaged 221 | '@Author: Anthony Mancini 222 | '@Version: 1.0.0 223 | '@License: MIT 224 | '@Param: array1 is the range that will be averaged 225 | '@Param: numberAveraged is the number of the bottom values that will be averaged 226 | '@Returns: Returns the average of the bottom numbers specified 227 | '@Example: =AverageLow({1,2,3,4}, 2) -> 1.5; as 1 and 2 will be averaged 228 | '@Example: =AverageLow({1,2,3,4}, 3) -> 2; as 1, 2, and 3 will be averaged 229 | 230 | Dim i As Integer 231 | Dim sumValue As Double 232 | 233 | For i = 1 To numberAveraged 234 | sumValue = sumValue + Small(array1, i) 235 | Next 236 | 237 | AverageLow = sumValue / numberAveraged 238 | 239 | End Function 240 | 241 | 242 | Public Function Large( _ 243 | ByVal array1 As Variant, _ 244 | ByVal nthNumber As Integer) _ 245 | As Variant 246 | 247 | '@Description: This function returns the nth highest number an in array, similar to Excel's LARGE function. 248 | '@Author: Anthony Mancini 249 | '@Version: 1.0.0 250 | '@License: MIT 251 | '@Param: array1 is the array that the number will be pulled from 252 | '@Param: nthNumber is the number of the top value that will be chosen. For example, a nthNumber of 1 results in the 1st highest value being chosen, when a number of 2 results in the 2nd, etc. 253 | '@Returns: Returns the nth highest number 254 | '@Example: =Large({1,2,3,4}, 1) -> 4 255 | '@Example: =Large({1,2,3,4}, 2) -> 3 256 | 257 | Large = Sort(array1)(UBound(array1) - (nthNumber - 1)) 258 | 259 | End Function 260 | 261 | 262 | Public Function Small( _ 263 | ByVal array1 As Variant, _ 264 | ByVal nthNumber As Integer) _ 265 | As Variant 266 | 267 | '@Description: This function returns the nth lowest number an in array, similar to Excel's SMALL function. 268 | '@Author: Anthony Mancini 269 | '@Version: 1.0.0 270 | '@License: MIT 271 | '@Param: array1 is the array that the number will be pulled from 272 | '@Param: nthNumber is the number of the bottom value that will be chosen. For example, a nthNumber of 1 results in the 1st smallest value being chosen, when a number of 2 results in the 2nd, etc. 273 | '@Returns: Returns the nth smallest number 274 | '@Example: =Small({1,2,3,4}, 1) -> 1 275 | '@Example: =Small({1,2,3,4}, 2) -> 2 276 | 277 | Small = Sort(array1, True)(UBound(array1) - (nthNumber - 1)) 278 | 279 | End Function 280 | 281 | Public Function IsInArray( _ 282 | ByVal value1 As Variant, _ 283 | ByVal array1 As Variant) _ 284 | As Boolean 285 | 286 | '@Description: This function checks if a value is in an array 287 | '@Author: Anthony Mancini 288 | '@Version: 1.0.0 289 | '@License: MIT 290 | '@Param: value1 is the value that will be checked if its in the array 291 | '@Param: array1 is the array 292 | '@Returns: Returns boolean True if the value is in the array, and false otherwise 293 | '@Example: =IsInArray("hello", {"one", 2, "hello"}) -> True 294 | '@Example: =IsInArray("hello", {1, "two", "three"}) -> False 295 | 296 | Dim individualElement As Variant 297 | 298 | For Each individualElement In array1 299 | If individualElement = value1 Then 300 | IsInArray = True 301 | Exit Function 302 | End If 303 | Next 304 | 305 | IsInArray = False 306 | 307 | End Function 308 | 309 | 310 | -------------------------------------------------------------------------------- /Modules/xlibValidators.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "xlibValidators" 2 | '@Module: This module contains a set of functions for validating some commonly used string, such as validators for email addresses and phone numbers. 3 | 4 | Option Explicit 5 | 6 | 7 | Public Function IsEmail( _ 8 | ByVal string1 As String) _ 9 | As Boolean 10 | 11 | '@Description: This function checks if a string is a valid email address. 12 | '@Author: Anthony Mancini 13 | '@Version: 1.0.0 14 | '@License: MIT 15 | '@Todo: Improve regex robustness 16 | '@Param: string1 is the string we are checking if its a valid email 17 | '@Returns: Returns TRUE if the string is a valid email, and FALSE if its invalid 18 | '@Example: =IsEmail("JohnDoe@testmail.com") -> TRUE 19 | '@Example: =IsEmail("JohnDoe@test/mail.com") -> FALSE 20 | '@Example: =IsEmail("not_an_email_address") -> FALSE 21 | 22 | Dim Regex As Object 23 | Set Regex = CreateObject("VBScript.RegExp") 24 | 25 | With Regex 26 | .Global = True 27 | .IgnoreCase = True 28 | .MultiLine = True 29 | .Pattern = "^[a-zA-Z0-9_.]*?[@][a-zA-Z0-9.]*?[.][a-zA-Z]{2,15}$" 30 | End With 31 | 32 | IsEmail = Regex.Test(string1) 33 | 34 | End Function 35 | 36 | 37 | Public Function IsPhone( _ 38 | ByVal string1 As String) _ 39 | As Boolean 40 | 41 | '@Description: This function checks if a string is a phone number is valid. 42 | '@Author: Anthony Mancini 43 | '@Version: 1.0.0 44 | '@License: MIT 45 | '@Todo: Improve regex robustness 46 | '@Todo: Add a second argument that lets the user add a country code and uses a different regex for phone number formats for that country. Also make the regx more robust so it can include more common formats. 47 | '@Param: string1 is the string we are checking if its a valid phone number 48 | '@Returns: Returns TRUE if the string is a valid phone number, and FALSE if its invalid 49 | '@Example: =IsPhone("123 456 7890") -> TRUE 50 | '@Example: =IsPhone("1234567890") -> TRUE 51 | '@Example: =IsPhone("1-234-567-890") -> FALSE; Not enough digits 52 | '@Example: =IsPhone("1-234-567-8905") -> TRUE 53 | '@Example: =IsPhone("+1-234-567-890") -> FALSE; Not enough digits 54 | '@Example: =IsPhone("+1-234-567-8905") -> TRUE 55 | '@Example: =IsPhone("+1-(234)-567-8905") -> TRUE 56 | '@Example: =IsPhone("+1 (234) 567 8905") -> TRUE 57 | '@Example: =IsPhone("1(234)5678905") -> TRUE 58 | '@Example: =IsPhone("123-456-789") -> FALSE; Not enough digits 59 | '@Example: =IsPhone("Hello World") -> FALSE; Not a phone number 60 | 61 | Dim Regex As Object 62 | Set Regex = CreateObject("VBScript.RegExp") 63 | 64 | With Regex 65 | .Global = True 66 | .IgnoreCase = True 67 | .MultiLine = True 68 | .Pattern = "^\s*[+]{0,1}[0-9]{0,1}[\s-]{0,1}\({0,1}([0-9]{3})\){0,1}[\s-]{0,1}([0-9]{3})[\s-]{0,1}([0-9]{4})$" 69 | End With 70 | 71 | IsPhone = Regex.Test(string1) 72 | 73 | End Function 74 | 75 | 76 | Public Function IsCreditCard( _ 77 | ByVal string1 As String) _ 78 | As Boolean 79 | 80 | '@Description: This function checks if a string is a valid credit card from one of the major card issuing companies. 81 | '@Author: Anthony Mancini 82 | '@Version: 1.0.0 83 | '@License: MIT 84 | '@Param: string1 is the string we are checking if its a valid credit card number 85 | '@Returns: Returns TRUE if the string is a valid credit card number, and FALSE if its invalid. Currently supports these cards: Visa, MasterCard, Discover, Amex, Diners, JCB 86 | '@Example: =IsCreditCard("5111567856785678") -> TRUE; This is a valid Mastercard number 87 | '@Example: =IsCreditCard("511156785678567") -> FALSE; Not enough digits 88 | '@Example: =IsCreditCard("9999999999999999") -> FALSE; Enough digits, but not a valid card number 89 | '@Example: =IsCreditCard("Hello World") -> FALSE 90 | 91 | Dim Regex As Object 92 | Set Regex = CreateObject("VBScript.RegExp") 93 | 94 | Dim regexPattern As String 95 | 96 | ' Regex for Amex 97 | regexPattern = regexPattern & "(3[47][0-9]{13})|" 98 | 99 | ' Regex for Diners 100 | regexPattern = regexPattern & "(3(0[0-5]|[68][0-9])?[0-9]{11})|" 101 | 102 | ' Regex for Discover 103 | regexPattern = regexPattern & "(6(011|5[0-9]{2})[0-9]{12})|" 104 | 105 | ' Regex for JCB 106 | regexPattern = regexPattern & "((2131|1800|35[0-9]{3})[0-9]{11})|" 107 | 108 | ' Regex for MasterCard 109 | regexPattern = regexPattern & "(5[1-5][0-9]{14})|" 110 | 111 | ' Regex for Visa 112 | regexPattern = regexPattern & "(4[0-9]{12}([0-9]{3})?)" 113 | 114 | With Regex 115 | .Global = True 116 | .IgnoreCase = True 117 | .MultiLine = True 118 | .Pattern = regexPattern 119 | End With 120 | 121 | IsCreditCard = Regex.Test(string1) 122 | 123 | End Function 124 | 125 | 126 | Public Function IsUrl( _ 127 | ByVal string1 As String) _ 128 | As Boolean 129 | 130 | '@Description: This function checks if a string is a valid URL address. 131 | '@Author: Anthony Mancini 132 | '@Version: 1.0.0 133 | '@License: MIT 134 | '@Todo: Improve regex robustness 135 | '@Param: string1 is the string we are checking if its a valid URL 136 | '@Returns: Returns TRUE if the string is a valid URL, and FALSE if its invalid 137 | '@Example: =IsUrl("https://www.wikipedia.org/") -> TRUE 138 | '@Example: =IsUrl("http://www.wikipedia.org/") -> TRUE 139 | '@Example: =IsUrl("hello_world") -> FALSE 140 | 141 | Dim Regex As Object 142 | Set Regex = CreateObject("VBScript.RegExp") 143 | 144 | With Regex 145 | .Global = True 146 | .IgnoreCase = True 147 | .MultiLine = True 148 | .Pattern = "http(s){0,1}://www.[a-zA-Z0-9_.]*?[.][a-zA-Z]{2,15}" 149 | End With 150 | 151 | IsUrl = Regex.Test(string1) 152 | 153 | End Function 154 | 155 | 156 | Public Function IsIPFour( _ 157 | ByVal string1 As String) _ 158 | As Boolean 159 | 160 | '@Description: This function checks if a string is a valid IPv4 address. 161 | '@Author: Anthony Mancini 162 | '@Version: 1.0.0 163 | '@License: MIT 164 | '@Todo: Improve regex robustness 165 | '@Param: string1 is the string we are checking if its a valid IPv4 address 166 | '@Returns: Returns TRUE if the string is a valid IPv4, and FALSE if its invalid 167 | '@Example: =IsIPFour("0.0.0.0") -> TRUE 168 | '@Example: =IsIPFour("100.100.100.100") -> TRUE 169 | '@Example: =IsIPFour("255.255.255.255") -> TRUE 170 | '@Example: =IsIPFour("255.255.255.256") -> FALSE; as the final 256 makes the address outside of the bounds of IPv4 171 | '@Example: =IsIPFour("0.0.0") -> FALSE; as the fourth octet is missing 172 | 173 | Dim Regex As Object 174 | Set Regex = CreateObject("VBScript.RegExp") 175 | 176 | With Regex 177 | .Global = True 178 | .IgnoreCase = True 179 | .MultiLine = True 180 | .Pattern = "^((2[0-4]\d|25[0-5]|1\d\d|\d{1,2})[.]){3}(2[0-4]\d|25[0-5]|1\d\d|\d{1,2})$" 181 | End With 182 | 183 | IsIPFour = Regex.Test(string1) 184 | 185 | End Function 186 | 187 | 188 | Public Function IsMacAddress( _ 189 | ByVal string1 As String) _ 190 | As Boolean 191 | 192 | '@Description: This function checks if a string is a valid 48-bit Mac Address. 193 | '@Author: Anthony Mancini 194 | '@Version: 1.0.0 195 | '@License: MIT 196 | '@Param: string1 is the string we are checking if its a valid 48-bit Mac Address 197 | '@Returns: Returns TRUE if the string is a valid 48-bit Mac Address, and FALSE if its invalid 198 | '@Example: =IsMacAddress("00:25:96:12:34:56") -> TRUE 199 | '@Example: =IsMacAddress("FF:FF:FF:FF:FF:FF") -> TRUE 200 | '@Example: =IsMacAddress("00-25-96-12-34-56") -> TRUE 201 | '@Example: =IsMacAddress("123.789.abc.DEF") -> TRUE 202 | '@Example: =IsMacAddress("Not A Mac Address") -> FALSE 203 | '@Example: =IsMacAddress("FF:FF:FF:FF:FF:FH") -> FALSE; the H at the end is not a valid Hex number 204 | 205 | Dim Regex As Object 206 | Set Regex = CreateObject("VBScript.RegExp") 207 | 208 | With Regex 209 | .Global = True 210 | .IgnoreCase = True 211 | .MultiLine = True 212 | .Pattern = "^(([a-fA-F0-9]{2}([:]|[-])){5}[a-fA-F0-9]{2}|([a-fA-F0-9]{3}[.]){3}[a-fA-F0-9]{3})$" 213 | End With 214 | 215 | IsMacAddress = Regex.Test(string1) 216 | 217 | End Function 218 | 219 | 220 | Public Function CreditCardName( _ 221 | ByVal string1 As String) _ 222 | As String 223 | 224 | '@Description: This function checks if a string is a valid credit card from one of the major card issuing companies, and then returns the name of the credit card name. This function assumes no spaces or hyphens (if you have card numbers with spaces or hyphens you can remove these using =SUBSTITUTE("-", "") function. 225 | '@Author: Anthony Mancini 226 | '@Version: 1.0.0 227 | '@License: MIT 228 | '@Param: string1 is the credit card string 229 | '@Returns: Returns the name of the credit card. Currently supports these cards: Visa, MasterCard, Discover, Amex, Diners, JCB 230 | '@Example: =CreditCardName("5111567856785678") -> "MasterCard"; This is a valid Mastercard number 231 | '@Example: =CreditCardName("not_a_card_number") -> #VALUE! 232 | 233 | Dim Regex As Object 234 | Set Regex = CreateObject("VBScript.RegExp") 235 | 236 | Regex.Global = True 237 | Regex.IgnoreCase = True 238 | Regex.MultiLine = True 239 | 240 | ' Regex for Amex 241 | Regex.Pattern = "(3[47][0-9]{13})" 242 | If Regex.Test(string1) Then 243 | CreditCardName = "Amex" 244 | Exit Function 245 | End If 246 | 247 | ' Regex for Diners 248 | Regex.Pattern = "(3(0[0-5]|[68][0-9])?[0-9]{11})" 249 | If Regex.Test(string1) Then 250 | CreditCardName = "Diners" 251 | Exit Function 252 | End If 253 | 254 | ' Regex for Discover 255 | Regex.Pattern = "(6(011|5[0-9]{2})[0-9]{12})" 256 | If Regex.Test(string1) Then 257 | CreditCardName = "Discover" 258 | Exit Function 259 | End If 260 | 261 | ' Regex for JCB 262 | Regex.Pattern = "((2131|1800|35[0-9]{3})[0-9]{11})" 263 | If Regex.Test(string1) Then 264 | CreditCardName = "JCB" 265 | Exit Function 266 | End If 267 | 268 | ' Regex for MasterCard 269 | Regex.Pattern = "(5[1-5][0-9]{14})" 270 | If Regex.Test(string1) Then 271 | CreditCardName = "MasterCard" 272 | Exit Function 273 | End If 274 | 275 | ' Regex for Visa 276 | Regex.Pattern = "(4[0-9]{12}([0-9]{3})?)" 277 | If Regex.Test(string1) Then 278 | CreditCardName = "Visa" 279 | Exit Function 280 | End If 281 | 282 | CreditCardName = "#NotAValidCreditCardNumber!" 283 | 284 | End Function 285 | 286 | 287 | Public Function FormatCreditCard( _ 288 | ByVal string1 As String) _ 289 | As String 290 | 291 | '@Description: This function checks if a string is a valid credit card, and if it is formats it in a more readable way. The format used is XXXX-XXXX-XXXX-XXXX. 292 | '@Author: Anthony Mancini 293 | '@Version: 1.0.0 294 | '@License: MIT 295 | '@Param: string1 is credit card number 296 | '@Returns: Returns a string formatted as a more readable credit card number 297 | '@Example: =FormatCreditCard("5111567856785678") -> "5111-5678-5678-5678" 298 | 299 | If IsCreditCard(string1) Then 300 | FormatCreditCard = Left(string1, 4) & "-" & Mid(string1, 5, 4) & "-" & Mid(string1, 9, 4) & "-" & Mid(string1, 13) 301 | Else 302 | FormatCreditCard = "#NotAValidCreditCardNumber!" 303 | End If 304 | 305 | End Function 306 | -------------------------------------------------------------------------------- /Modules/xlibFileTests.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "xlibFileTests" 2 | Option Explicit 3 | 4 | Public Function AllXlibFileTests() 5 | 6 | Dim TestStatus As Boolean 7 | TestStatus = True 8 | 9 | Debug.Print "========================================" 10 | 11 | ' Begin Tests 12 | If Not GetActivePathAndNameTest() Then 13 | Debug.Print "Failed: GetActivePathAndNameTest" 14 | TestStatus = False 15 | Else 16 | Debug.Print "Passed: GetActivePathAndNameTest" 17 | End If 18 | 19 | If Not GetActivePathTest() Then 20 | Debug.Print "Failed: GetActivePathTest" 21 | TestStatus = False 22 | Else 23 | Debug.Print "Passed: GetActivePathTest" 24 | End If 25 | 26 | If Not FileCreationTimeTest() Then 27 | Debug.Print "Failed: FileCreationTimeTest" 28 | TestStatus = False 29 | Else 30 | Debug.Print "Passed: FileCreationTimeTest" 31 | End If 32 | 33 | If Not FileLastModifiedTimeTest() Then 34 | Debug.Print "Failed: FileLastModifiedTimeTest" 35 | TestStatus = False 36 | Else 37 | Debug.Print "Passed: FileLastModifiedTimeTest" 38 | End If 39 | 40 | If Not FileDriveTest() Then 41 | Debug.Print "Failed: FileDriveTest" 42 | TestStatus = False 43 | Else 44 | Debug.Print "Passed: FileDriveTest" 45 | End If 46 | 47 | If Not FileNameTest() Then 48 | Debug.Print "Failed: FileNameTest" 49 | TestStatus = False 50 | Else 51 | Debug.Print "Passed: FileNameTest" 52 | End If 53 | 54 | If Not FileFolderTest() Then 55 | Debug.Print "Failed: FileFolderTest" 56 | TestStatus = False 57 | Else 58 | Debug.Print "Passed: FileFolderTest" 59 | End If 60 | 61 | If Not CurrentFilePathTest() Then 62 | Debug.Print "Failed: CurrentFilePathTest" 63 | TestStatus = False 64 | Else 65 | Debug.Print "Passed: CurrentFilePathTest" 66 | End If 67 | 68 | If Not FileSizeTest() Then 69 | Debug.Print "Failed: FileSizeTest" 70 | TestStatus = False 71 | Else 72 | Debug.Print "Passed: FileSizeTest" 73 | End If 74 | 75 | If Not FileTypeTest() Then 76 | Debug.Print "Failed: FileTypeTest" 77 | TestStatus = False 78 | Else 79 | Debug.Print "Passed: FileTypeTest" 80 | End If 81 | 82 | If Not FileExtensionTest() Then 83 | Debug.Print "Failed: FileExtensionTest" 84 | TestStatus = False 85 | Else 86 | Debug.Print "Passed: FileExtensionTest" 87 | End If 88 | 89 | If Not WriteFileTest() Then 90 | Debug.Print "Failed: WriteFileTest" 91 | TestStatus = False 92 | Else 93 | Debug.Print "Passed: WriteFileTest" 94 | End If 95 | 96 | If Not ReadFileTest() Then 97 | Debug.Print "Failed: ReadFileTest" 98 | TestStatus = False 99 | Else 100 | Debug.Print "Passed: ReadFileTest" 101 | End If 102 | 103 | If Not PathSeparatorTest() Then 104 | Debug.Print "Failed: PathSeparatorTest" 105 | TestStatus = False 106 | Else 107 | Debug.Print "Passed: PathSeparatorTest" 108 | End If 109 | 110 | If Not PathJoinTest() Then 111 | Debug.Print "Failed: PathJoinTest" 112 | TestStatus = False 113 | Else 114 | Debug.Print "Passed: PathJoinTest" 115 | End If 116 | 117 | If Not CountFilesTest() Then 118 | Debug.Print "Failed: CountFilesTest" 119 | TestStatus = False 120 | Else 121 | Debug.Print "Passed: CountFilesTest" 122 | End If 123 | 124 | If Not CountFilesAndFoldersTest() Then 125 | Debug.Print "Failed: CountFilesAndFoldersTest" 126 | TestStatus = False 127 | Else 128 | Debug.Print "Passed: CountFilesAndFoldersTest" 129 | End If 130 | 131 | If Not GetFileNameByNumberTest() Then 132 | Debug.Print "Failed: GetFileNameByNumberTest" 133 | TestStatus = False 134 | Else 135 | Debug.Print "Passed: GetFileNameByNumberTest" 136 | End If 137 | ' End Tests 138 | 139 | Debug.Print "----------------------------------------" 140 | 141 | If TestStatus Then 142 | Debug.Print "Passed All Tests" 143 | Else 144 | Debug.Print "!!! FAILED TESTS !!!" 145 | End If 146 | 147 | Debug.Print "========================================" 148 | 149 | AllXlibFileTests = TestStatus 150 | 151 | End Function 152 | 153 | 154 | 155 | Private Function GetActivePathAndNameTest() As Boolean 156 | 157 | '@Example: =GetActivePathAndName() -> "C:\Users\UserName\Documents\XLib.xlsm" 158 | 159 | GetActivePathAndNameTest = True 160 | 161 | If InStr(1, GetActivePathAndName(), ".") > 0 Then 162 | #If Mac Then 163 | If InStr(1, GetActivePathAndName(), "/") > 0 Then 164 | GetActivePathAndNameTest = True 165 | Else 166 | GetActivePathAndNameTest = False 167 | End If 168 | #Else 169 | If InStr(1, GetActivePathAndName(), ":\") > 0 Then 170 | GetActivePathAndNameTest = True 171 | Else 172 | GetActivePathAndNameTest = False 173 | End If 174 | #End If 175 | End If 176 | 177 | End Function 178 | 179 | 180 | Private Function GetActivePathTest() As Boolean 181 | 182 | '@Example: =GetActivePath() -> "C:\Users\UserName\Documents\" 183 | 184 | GetActivePathTest = True 185 | 186 | #If Mac Then 187 | If InStr(1, GetActivePath(), "/") > 0 Then 188 | GetActivePathTest = True 189 | Else 190 | GetActivePathTest = False 191 | End If 192 | #Else 193 | If InStr(1, GetActivePath(), ":\") > 0 Then 194 | GetActivePathTest = True 195 | Else 196 | GetActivePathTest = False 197 | End If 198 | #End If 199 | 200 | End Function 201 | 202 | 203 | Private Function FileCreationTimeTest() As Boolean 204 | 205 | '@Example: =FileCreationTime() -> "1/1/2020 1:23:45 PM" 206 | '@Example: =FileCreationTime("C:\hello\world.txt") -> "1/1/2020 5:55:55 PM" 207 | '@Example: =FileCreationTime("vba.txt") -> "12/25/2000 1:00:00 PM"; Where "vba.txt" resides in the same folder as the workbook, document, presentation, or database this function resides in 208 | 209 | FileCreationTimeTest = False 210 | 211 | If InStr(1, FileCreationTime(), " ") > 0 Then 212 | If InStr(1, FileCreationTime(), ":") > 0 Then 213 | FileCreationTimeTest = True 214 | End If 215 | End If 216 | 217 | End Function 218 | 219 | 220 | Private Function FileLastModifiedTimeTest() As Boolean 221 | 222 | '@Example: =FileLastModifiedTime() -> "1/1/2020 2:23:45 PM" 223 | '@Example: =FileLastModifiedTime("C:\hello\world.txt") -> "1/1/2020 7:55:55 PM" 224 | '@Example: =FileLastModifiedTime("vba.txt") -> "12/25/2000 3:00:00 PM"; Where "vba.txt" resides in the same folder as the workbook, document, presentation, or database this function resides in 225 | 226 | FileLastModifiedTimeTest = False 227 | 228 | If InStr(1, FileLastModifiedTime(), " ") > 0 Then 229 | If InStr(1, FileLastModifiedTime(), ":") > 0 Then 230 | FileLastModifiedTimeTest = True 231 | End If 232 | End If 233 | 234 | End Function 235 | 236 | 237 | Private Function FileDriveTest() As Boolean 238 | 239 | '@Example: =FileDrive() -> "A:"; Where the current workbook resides on the A: drive 240 | '@Example: =FileDrive("C:\hello\world.txt") -> "C:" 241 | '@Example: =FileDrive("vba.txt") -> "B:"; Where "vba.txt" resides in the same folder as the workbook, document, presentation, or database this function resides in, and where the workbook resides in the B: drive 242 | 243 | If InStr(1, FileDrive(), ":") > 0 Then 244 | FileDriveTest = True 245 | End If 246 | 247 | End Function 248 | 249 | 250 | Private Function FileNameTest() As Boolean 251 | 252 | '@Example: =FileName() -> "MyWorkbook.xlsm" 253 | '@Example: =FileName("C:\hello\world.txt") -> "world.txt" 254 | '@Example: =FileName("vba.txt") -> "vba.txt"; Where "vba.txt" resides in the same folder as the workbook, document, presentation, or database this function resides in 255 | 256 | If Len(FileName()) > 0 Then 257 | FileNameTest = True 258 | End If 259 | 260 | End Function 261 | 262 | 263 | Private Function FileFolderTest() As Boolean 264 | 265 | '@Example: =FileFolder() -> "C:\my_excel_files" 266 | '@Example: =FileFolder("C:\hello\world.txt") -> "C:\hello" 267 | '@Example: =FileFolder("vba.txt") -> "C:\my_excel_files"; Where "vba.txt" resides in the same folder as the workbook, document, presentation, or database this function resides in 268 | 269 | #If Mac Then 270 | If InStr(1, FileFolder(), "/") > 0 Then 271 | FileFolderTest = True 272 | End If 273 | #Else 274 | If InStr(1, FileFolder(), ":\") > 0 Then 275 | FileFolderTest = True 276 | End If 277 | #End If 278 | 279 | End Function 280 | 281 | 282 | Private Function CurrentFilePathTest() As Boolean 283 | 284 | '@Example: =CurrentFilePath() -> "C:\my_excel_files\MyWorkbook.xlsx" 285 | '@Example: =CurrentFilePath("C:\hello\world.txt") -> "C:\hello\world.txt" 286 | '@Example: =CurrentFilePath("vba.txt") -> "C:\hello\world.txt"; Where "vba.txt" resides in the same folder as the workbook, document, presentation, or database this function resides in 287 | 288 | #If Mac Then 289 | If InStr(1, CurrentFilePath(), "/") > 0 Then 290 | CurrentFilePathTest = True 291 | End If 292 | #Else 293 | If InStr(1, CurrentFilePath(), ":\") > 0 Then 294 | CurrentFilePathTest = True 295 | End If 296 | #End If 297 | 298 | End Function 299 | 300 | 301 | Private Function FileSizeTest() As Boolean 302 | 303 | '@Example: =FileSize() -> 1024 304 | '@Example: =FileSize(,"KB") -> 1 305 | '@Example: =FileSize("vba.txt", "KB") -> 0.25; Where "vba.txt" resides in the same folder as the workbook, document, presentation, or database this function resides in 306 | 307 | If FileSize() > 0 Then 308 | FileSizeTest = True 309 | End If 310 | 311 | End Function 312 | 313 | 314 | Private Function FileTypeTest() As Boolean 315 | 316 | '@Example: FileType() -> "Microsoft Excel Macro-Enabled Worksheet" 317 | '@Example: FileType("C:\hello\world.txt") -> "Text Document" 318 | '@Example: FileType("vba.txt") -> "Text Document"; Where "vba.txt" resides in the same folder as the workbook, document, presentation, or database this function resides in 319 | 320 | If Len(FileType()) > 0 Then 321 | FileTypeTest = True 322 | End If 323 | 324 | End Function 325 | 326 | 327 | Private Function FileExtensionTest() As Boolean 328 | 329 | '@Example: =FileExtension() = "xlsx" 330 | '@Example: =FileExtension("C:\hello\world.txt") -> "txt" 331 | '@Example: =FileExtension("vba.txt") -> "txt"; Where "vba.txt" resides in the same folder as the workbook, document, presentation, or database this function resides in 332 | 333 | If Len(FileExtension()) > 0 Then 334 | FileExtensionTest = True 335 | End If 336 | 337 | End Function 338 | 339 | 340 | Private Function WriteFileTest() As Boolean 341 | 342 | '@Example: =WriteFile("C:\MyWorkbookFolder\hello.txt", "Hello World") -> "Successfully wrote to: C:\MyWorkbookFolder\hello.txt" 343 | '@Example: =WriteFile("hello.txt", "Hello World") -> "Successfully wrote to: C:\MyWorkbookFolder\hello.txt"; Where the Workbook resides in "C:\MyWorkbookFolder\" 344 | 345 | If WriteFile("TempTestFile.txt", "Hello World") Then 346 | WriteFileTest = True 347 | End If 348 | 349 | End Function 350 | 351 | 352 | Private Function ReadFileTest() As Boolean 353 | 354 | '@Example: =ReadFile("C:\hello\world.txt") -> "Hello" World 355 | '@Example: =ReadFile("vba.txt") -> "This is my VBA text file"; Where "vba.txt" resides in the same folder as the workbook, document, presentation, or database this function resides in 356 | '@Example: =ReadFile("multline.txt", 1) -> "This is line 1"; 357 | '@Example: =ReadFile("multline.txt", 2) -> "This is line 2"; 358 | 359 | ReadFileTest = IIf(ReadFile("TempTestFile.txt") = "Hello World", True, False) 360 | Kill (GetActivePath() & "TempTestFile.txt") 361 | 362 | End Function 363 | 364 | 365 | Private Function PathSeparatorTest() As Boolean 366 | 367 | '@Example: =PathSeparator() -> "\"; When running this code on Windows 368 | '@Example: =PathSeparator() -> "/"; When running this code on Mac 369 | 370 | If PathSeparator() = "\" Or PathSeparator() = "/" Then 371 | PathSeparatorTest = True 372 | End If 373 | 374 | End Function 375 | 376 | 377 | Private Function PathJoinTest() As Boolean 378 | 379 | '@Example: =PathJoin("C:", "hello", "world.txt") -> "C:\hello\world.txt"; On Windows 380 | '@Example: =PathJoin("hello", "world.txt") -> "/hello/world.txt"; On Mac 381 | 382 | If PathJoin("hello", "world") = "hello/world" Or PathJoin("hello", "world") = "hello\world" Then 383 | PathJoinTest = True 384 | End If 385 | 386 | End Function 387 | 388 | 389 | Private Function CountFilesTest() As Boolean 390 | 391 | '@Example: =CountFiles() -> 6 392 | '@Example: =CountFiles("C:\hello") -> 10 393 | 394 | If CountFiles() > 0 Then 395 | CountFilesTest = True 396 | End If 397 | 398 | End Function 399 | 400 | 401 | Private Function CountFilesAndFoldersTest() As Boolean 402 | 403 | '@Example: =CountFilesAndFolders() -> 8 404 | '@Example: =CountFilesAndFolders("C:\hello") -> 30 405 | 406 | If CountFilesAndFolders() > 0 Then 407 | CountFilesAndFoldersTest = True 408 | End If 409 | 410 | End Function 411 | 412 | 413 | Private Function GetFileNameByNumberTest() As Boolean 414 | 415 | '@Example: =GetFileName(,1) -> "hello.txt" 416 | '@Example: =GetFileName(,1) -> "world.txt" 417 | '@Example: =GetFileName("C:\hello", 1) -> "one.txt" 418 | '@Example: =GetFileName("C:\hello", 1) -> "two.txt" 419 | '@Example: =GetFileName("C:\hello", 1) -> "three.txt" 420 | 421 | If Len(GetFileNameByNumber()) > 0 Then 422 | GetFileNameByNumberTest = True 423 | End If 424 | 425 | End Function 426 | 427 | 428 | -------------------------------------------------------------------------------- /Modules/xlibNetwork.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "xlibNetwork" 2 | '@Module: This module contains a set of functions for performing networking tasks such as performing HTTP requests and parsing HTML. 3 | 4 | Option Explicit 5 | 6 | 7 | Public Function Http( _ 8 | ByVal url As String, _ 9 | Optional ByVal httpMethod As String = "GET", _ 10 | Optional ByVal headers As Variant, _ 11 | Optional ByVal postData As Variant = "", _ 12 | Optional ByVal asyncFlag As Boolean, _ 13 | Optional ByVal statusErrorHandlerFlag As Boolean, _ 14 | Optional ByVal parseArguments As Variant) _ 15 | As String 16 | 17 | '@Description: This function performs an HTTP request to the web and returns the response as a string. It provides many options to change the http method, provide data for a POST request, change the headers, handle errors for non-successful requests, and parse out text from a request using a light parsing language. 18 | '@Author: Anthony Mancini 19 | '@Version: 1.0.0 20 | '@License: MIT 21 | '@Param: url is a string of the URL of the website you want to fetch data from 22 | '@Param: httpMethod is a string with the http method, with the default being a GET request. For POST requests, use "POST", for PUT use "PUT", and for DELETE use "DELETE" 23 | '@Param: headers is either an array or a Scripting Dictionary of headers that will be used in the request. For an array, the 1st, 3rd, 5th... will be used as the key and the 2nd, 4th, 6th... will be used as the values. For a Scripting Dictionary, the dictionary keys will be used as header keys, and the values as values. Finally, in the case when no headers are set, the User-Agent will be set to "XPlus" as a courtesy to the web server. 24 | '@Param: postData is a string that will contain data for a POST request 25 | '@Param: asyncFlag is a Boolean value that if set to TRUE will make the request asynchronous. By default requests will be synchronous, which will lock Excel while fetching but will also prevent errors when performing calculations based on fetched data. 26 | '@Param: statusErrorHandlerFlag is a Boolean value that if set to TRUE will result in a User-Defined Error String being returned for all non 200 requests that tells the user the status code that occured. This flag is useful in cases where requests need to be successful and if not errors should be thrown. 27 | '@Param: parseArguments is an array of arguments that perform string parsing on the response. It uses a light scripting language that includes commands similar to the Excel Built-in LEFT(), RIGHT(), and MID() that allow you to parse the request before it gets returned. See the Note on the scripting language, and the Warning on why this argument should be used. 28 | '@Returns: Returns the parsed HTTP response as a string 29 | '@Note: The parseArguments parameter uses a light scripting language to perform string manipulations on the HTTP response text that allows you to parse out the relevant information to you. The language contains 5 commands that can be used for parsing. Please check out the examples as well below for a better understanding of how to use the parsing language:Hello World
") -> "<p>Hello World</p>" 208 | 209 | string1 = Replace(string1, "&", "&") 210 | string1 = Replace(string1, Chr(34), """) 211 | string1 = Replace(string1, "'", "'") 212 | string1 = Replace(string1, "<", "<") 213 | string1 = Replace(string1, ">", ">") 214 | 215 | HtmlEscape = string1 216 | 217 | End Function 218 | 219 | 220 | Public Function HtmlUnescape( _ 221 | ByVal string1 As String) _ 222 | As String 223 | 224 | '@Description: This function takes a string and unescapes the HTML characters in it. For example, the character "%gt;" will be escaped into ">" 225 | '@Author: Anthony Mancini 226 | '@Version: 1.0.0 227 | '@License: MIT 228 | '@Param: string1 is the string that will have its characters HTML unescaped 229 | '@Returns: Returns an HTML unescaped string 230 | '@Example: =HtmlUnescape("<p>Hello World</p>") -> "Hello World
" 231 | 232 | string1 = Replace(string1, "&", "&") 233 | string1 = Replace(string1, """, Chr(34)) 234 | string1 = Replace(string1, "'", "'") 235 | string1 = Replace(string1, "<", "<") 236 | string1 = Replace(string1, ">", ">") 237 | 238 | HtmlUnescape = string1 239 | 240 | End Function 241 | 242 | 243 | Private Sub CallTextToSpeech(combinedString) 244 | 245 | '@Description: This subroutine simply calls the text-to-speech API 246 | '@Author: Anthony Mancini 247 | '@Version: 1.0.0 248 | '@License: MIT 249 | '@Param: combinedString is the string that will be spoken 250 | 251 | Application.Speech.Speak combinedString, True 252 | 253 | End Sub 254 | 255 | 256 | Public Function SpeakText( _ 257 | ParamArray textArray() As Variant) _ 258 | As String 259 | 260 | '@Description: This function takes the range of the cell that this function resides, and then an array of text, and when this function is recalculated manually by the user (for example when pressing the F2 key while on the cell) this function will use Microsoft's text-to-speech to speak out the text through the speakers or microphone. 261 | '@Author: Anthony Mancini 262 | '@Version: 1.0.0 263 | '@License: MIT 264 | '@Param: textArray() is an array of ranges, strings, or number that will be displayed 265 | '@Note: Note that text-to-speech is only available on Microsoft Excel. This function will still return the combined string from the text array, but will only result in speech through the speakers in Microsoft Excel 266 | '@Returns: Returns all the strings in the text array combined as well as displays all the text in the text array 267 | '@Example: =SpeakText("Hello", "World") -> "Hello World" and the text will be spoken through the speaker 268 | 269 | Dim combinedString As String 270 | Dim individualTextItem As Variant 271 | 272 | For Each individualTextItem In textArray 273 | combinedString = combinedString & individualTextItem & " " 274 | Next 275 | 276 | If Application.Name = "Microsoft Excel" Then 277 | CallTextToSpeech combinedString 278 | End If 279 | 280 | SpeakText = Trim(combinedString) 281 | 282 | End Function 283 | 284 | 285 | Public Function Dec2Hex( _ 286 | ByVal number As Long, _ 287 | Optional ByVal zeroFillAmount As Integer) _ 288 | As String 289 | 290 | '@Description: This function takes an integer and converts it to a hex string, with the option to specify the number of leading zeros for the hex string returned 291 | '@Author: Anthony Mancini 292 | '@Version: 1.0.0 293 | '@License: MIT 294 | '@Param: number is the integer that will be converted to a hex string 295 | '@Returns: Returns the number rounded down to the nearest integer 296 | '@Example: =Dec2Hex(5) -> "5" 297 | '@Example: =Dec2Hex(5, 2) -> "05" 298 | '@Example: =Dec2Hex(255, 2) -> "FF" 299 | '@Example: =Dec2Hex(255, 8) -> "000000FF" 300 | 301 | Dim i As Integer 302 | Dim hexString As String 303 | 304 | hexString = Hex(number) 305 | 306 | If zeroFillAmount > 0 Then 307 | While Len(hexString) < zeroFillAmount 308 | hexString = "0" & hexString 309 | Wend 310 | End If 311 | 312 | Dec2Hex = hexString 313 | 314 | End Function 315 | 316 | 317 | Public Function BigDec2Hex( _ 318 | ByVal number As Variant, _ 319 | Optional ByVal zeroFillAmount As Integer) _ 320 | As String 321 | 322 | '@Description: This function is an implementation of Dec2Hex that allows big integers up to 14-byte to be used 323 | '@Author: Anthony Mancini 324 | '@Version: 1.0.0 325 | '@License: MIT 326 | '@Param: number is the integer that will be converted to a hex string 327 | '@Returns: Returns the number rounded down to the nearest integer 328 | '@Example: =Dec2Hex(255, 8) -> "000000FF" 329 | '@Example: =Dec2Hex(3000000000, 16) -> Error; As Dec2Hex does not support integers this large 330 | '@Example: =BigDec2Hex(3000000000, 16) -> "00000000B2D05E00" 331 | 332 | Dim i As Integer 333 | Dim hexString As String 334 | 335 | hexString = BigHex(number) 336 | 337 | If zeroFillAmount > 0 Then 338 | While Len(hexString) < zeroFillAmount 339 | hexString = "0" & hexString 340 | Wend 341 | End If 342 | 343 | BigDec2Hex = hexString 344 | 345 | End Function 346 | 347 | 348 | Public Function BigHex( _ 349 | ByVal number As Variant) _ 350 | As String 351 | 352 | '@Description: This function is an implementation of the Hex() function that allows for 14-byte integers to be used 353 | '@Author: Anthony Mancini 354 | '@Version: 1.0.0 355 | '@License: MIT 356 | '@Param: number is the number that will be converted to hex 357 | '@Returns: Returns a string of the number converted to hex 358 | '@Example: =BigHex(255) -> "FF" 359 | '@Example: =Hex(3000000000) -> Error; As hex does not support big integers 360 | '@Example: =BigHex(3000000000) -> "B2D05E00" 361 | 362 | Dim integerString As String 363 | Dim decimalString As String 364 | Dim hexString As String 365 | 366 | While number > 0 367 | number = number / 16 368 | If InStr(1, CStr(number), ".") > 0 Then 369 | integerString = Split(CStr(number), ".")(0) 370 | decimalString = Split(CStr(number), ".")(1) 371 | Else 372 | integerString = CStr(number) 373 | decimalString = "0" 374 | End If 375 | 376 | Select Case decimalString 377 | Case "0" 378 | hexString = "0" & hexString 379 | Case "0625" 380 | hexString = "1" & hexString 381 | Case "125" 382 | hexString = "2" & hexString 383 | Case "1875" 384 | hexString = "3" & hexString 385 | Case "25" 386 | hexString = "4" & hexString 387 | Case "3125" 388 | hexString = "5" & hexString 389 | Case "375" 390 | hexString = "6" & hexString 391 | Case "4375" 392 | hexString = "7" & hexString 393 | Case "5" 394 | hexString = "8" & hexString 395 | Case "5625" 396 | hexString = "9" & hexString 397 | Case "625" 398 | hexString = "A" & hexString 399 | Case "6875" 400 | hexString = "B" & hexString 401 | Case "75" 402 | hexString = "C" & hexString 403 | Case "8125" 404 | hexString = "D" & hexString 405 | Case "875" 406 | hexString = "E" & hexString 407 | Case "9375" 408 | hexString = "F" & hexString 409 | End Select 410 | 411 | number = Fix(number) 412 | Wend 413 | 414 | BigHex = hexString 415 | 416 | End Function 417 | 418 | Public Function Hex2Dec( _ 419 | ByVal hexNumber As String) _ 420 | As Long 421 | 422 | '@Description: This function takes a hex number as a string and converts it to a decimal long 423 | '@Author: Anthony Mancini 424 | '@Version: 1.0.0 425 | '@License: MIT 426 | '@Param: hexNumber is the hex number that will be converted to a long 427 | '@Returns: Returns a decimal base number converted from the hex number 428 | '@Example: =Hex2Dec("FF") -> 255 429 | '@Example: =Hex2Dec("FFFF") -> 65535 430 | 431 | Hex2Dec = CLng("&H" & hexNumber) 432 | 433 | End Function 434 | 435 | 436 | Public Function Len2( _ 437 | ByVal val As Variant) _ 438 | As Integer 439 | 440 | '@Description: This function is an extension on the Len() function by returning the length of strings, arrays, numbers, and many other objects in Excel, Word, PowerPoint, and Access, including Objects such as Dictionaries. Internally, any Object that implements a .Count property will have a length returned by this function. Also, any number used within this function will be converted to a string and then its length returned. 441 | '@Author: Anthony Mancini 442 | '@Version: 1.0.0 443 | '@License: MIT 444 | '@Param: val is the value you want the length from 445 | '@Returns: Returns an integer of the length of the value specified 446 | '@Example: =Len2("Hello") -> 5; As the string is 5 characters long 447 | '@Example: =Len2(arr) -> 3; Where arr is an array with {1, 2, 3} in it, and the array has 3 values in it 448 | '@Example: =Len2("100") -> 3; As the string is 3 characters long 449 | '@Example: =Len2(100) -> 3; As the integer is 3 characters long when converted to a string 450 | '@Example: =Len2(Range("A1:A3")) -> 3; As the Excel Range has 3 451 | '@Example: =Len2(col) -> 5; Where col is a Collection with 5 items in it 452 | '@Example: =Len2(dict) -> 2; Where dict is a Dictionary with 2 key/value pairs in it 453 | '@Example: =Len2(Application.Documents) -> 3; Where we currently have 3 documents open 454 | '@Example: =Len2(Application.ActivePresentation.Slides) -> 10; Where the active PowerPoint Presentation has 10 slides 455 | 456 | If IsArray(val) And Right(TypeName(val), 2) = "()" Then 457 | Len2 = UBound(val) - LBound(val) + 1 458 | ElseIf TypeName(val) = "String" Then 459 | Len2 = Len(val) 460 | ElseIf IsNumeric(val) Then 461 | Len2 = Len(CStr(val)) 462 | Else 463 | Len2 = val.Count 464 | End If 465 | 466 | End Function 467 | 468 | -------------------------------------------------------------------------------- /Modules/xlibStringManipulationTests.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "xlibStringManipulationTests" 2 | Option Explicit 3 | 4 | Public Function AllXlibStringManipulationTests() 5 | 6 | Dim TestStatus As Boolean 7 | TestStatus = True 8 | 9 | Debug.Print "========================================" 10 | 11 | ' Begin Tests 12 | If Not CapitalizeTest() Then 13 | Debug.Print "Failed: CapitalizeTest" 14 | TestStatus = False 15 | Else 16 | Debug.Print "Passed: CapitalizeTest" 17 | End If 18 | 19 | If Not LeftFindTest() Then 20 | Debug.Print "Failed: LeftFindTest" 21 | TestStatus = False 22 | Else 23 | Debug.Print "Passed: LeftFindTest" 24 | End If 25 | 26 | If Not RightFindTest() Then 27 | Debug.Print "Failed: RightFindTest" 28 | TestStatus = False 29 | Else 30 | Debug.Print "Passed: RightFindTest" 31 | End If 32 | 33 | If Not LeftSearchTest() Then 34 | Debug.Print "Failed: LeftSearchTest" 35 | TestStatus = False 36 | Else 37 | Debug.Print "Passed: LeftSearchTest" 38 | End If 39 | 40 | If Not RightSearchTest() Then 41 | Debug.Print "Failed: RightSearchTest" 42 | TestStatus = False 43 | Else 44 | Debug.Print "Passed: RightSearchTest" 45 | End If 46 | 47 | If Not SubstrTest() Then 48 | Debug.Print "Failed: SubstrTest" 49 | TestStatus = False 50 | Else 51 | Debug.Print "Passed: SubstrTest" 52 | End If 53 | 54 | If Not SubstrFindTest() Then 55 | Debug.Print "Failed: SubstrFindTest" 56 | TestStatus = False 57 | Else 58 | Debug.Print "Passed: SubstrFindTest" 59 | End If 60 | 61 | If Not SubstrSearchTest() Then 62 | Debug.Print "Failed: SubstrSearchTest" 63 | TestStatus = False 64 | Else 65 | Debug.Print "Passed: SubstrSearchTest" 66 | End If 67 | 68 | If Not RepeatTest() Then 69 | Debug.Print "Failed: RepeatTest" 70 | TestStatus = False 71 | Else 72 | Debug.Print "Passed: RepeatTest" 73 | End If 74 | 75 | If Not FormatterTest() Then 76 | Debug.Print "Failed: FormatterTest" 77 | TestStatus = False 78 | Else 79 | Debug.Print "Passed: FormatterTest" 80 | End If 81 | 82 | If Not ZfillTest() Then 83 | Debug.Print "Failed: ZfillTest" 84 | TestStatus = False 85 | Else 86 | Debug.Print "Passed: ZfillTest" 87 | End If 88 | 89 | If Not SplitTextTest() Then 90 | Debug.Print "Failed: SplitTextTest" 91 | TestStatus = False 92 | Else 93 | Debug.Print "Passed: SplitTextTest" 94 | End If 95 | 96 | If Not CountWordsTest() Then 97 | Debug.Print "Failed: CountWordsTest" 98 | TestStatus = False 99 | Else 100 | Debug.Print "Passed: CountWordsTest" 101 | End If 102 | 103 | If Not CamelCaseTest() Then 104 | Debug.Print "Failed: CamelCaseTest" 105 | TestStatus = False 106 | Else 107 | Debug.Print "Passed: CamelCaseTest" 108 | End If 109 | 110 | If Not KebabCaseTest() Then 111 | Debug.Print "Failed: KebabCaseTest" 112 | TestStatus = False 113 | Else 114 | Debug.Print "Passed: KebabCaseTest" 115 | End If 116 | 117 | If Not RemoveCharactersTest() Then 118 | Debug.Print "Failed: RemoveCharactersTest" 119 | TestStatus = False 120 | Else 121 | Debug.Print "Passed: RemoveCharactersTest" 122 | End If 123 | 124 | If Not CompanyCaseTest() Then 125 | Debug.Print "Failed: CompanyCaseTest" 126 | TestStatus = False 127 | Else 128 | Debug.Print "Passed: CompanyCaseTest" 129 | End If 130 | 131 | If Not ReverseTextTest() Then 132 | Debug.Print "Failed: ReverseTextTest" 133 | TestStatus = False 134 | Else 135 | Debug.Print "Passed: ReverseTextTest" 136 | End If 137 | 138 | If Not ReverseWordsTest() Then 139 | Debug.Print "Failed: ReverseWordsTest" 140 | TestStatus = False 141 | Else 142 | Debug.Print "Passed: ReverseWordsTest" 143 | End If 144 | 145 | If Not IndentTextTest() Then 146 | Debug.Print "Failed: IndentTextTest" 147 | TestStatus = False 148 | Else 149 | Debug.Print "Passed: IndentTextTest" 150 | End If 151 | 152 | If Not DedentTextTest() Then 153 | Debug.Print "Failed: DedentTextTest" 154 | TestStatus = False 155 | Else 156 | Debug.Print "Passed: DedentTextTest" 157 | End If 158 | 159 | If Not ShortenTextTest() Then 160 | Debug.Print "Failed: ShortenTextTest" 161 | TestStatus = False 162 | Else 163 | Debug.Print "Passed: ShortenTextTest" 164 | End If 165 | 166 | If Not InSplitTest() Then 167 | Debug.Print "Failed: InSplitTest" 168 | TestStatus = False 169 | Else 170 | Debug.Print "Passed: InSplitTest" 171 | End If 172 | 173 | If Not EliteCaseTest() Then 174 | Debug.Print "Failed: EliteCaseTest" 175 | TestStatus = False 176 | Else 177 | Debug.Print "Passed: EliteCaseTest" 178 | End If 179 | 180 | If Not ScrambleCaseTest() Then 181 | Debug.Print "Failed: ScrambleCaseTest" 182 | TestStatus = False 183 | Else 184 | Debug.Print "Passed: ScrambleCaseTest" 185 | End If 186 | 187 | If Not LeftSplitTest() Then 188 | Debug.Print "Failed: LeftSplitTest" 189 | TestStatus = False 190 | Else 191 | Debug.Print "Passed: LeftSplitTest" 192 | End If 193 | 194 | If Not RightSplitTest() Then 195 | Debug.Print "Failed: RightSplitTest" 196 | TestStatus = False 197 | Else 198 | Debug.Print "Passed: RightSplitTest" 199 | End If 200 | 201 | If Not TrimCharTest() Then 202 | Debug.Print "Failed: TrimCharTest" 203 | TestStatus = False 204 | Else 205 | Debug.Print "Passed: TrimCharTest" 206 | End If 207 | 208 | If Not TrimLeftTest() Then 209 | Debug.Print "Failed: TrimLeftTest" 210 | TestStatus = False 211 | Else 212 | Debug.Print "Passed: TrimLeftTest" 213 | End If 214 | 215 | If Not TrimRightTest() Then 216 | Debug.Print "Failed: TrimRightTest" 217 | TestStatus = False 218 | Else 219 | Debug.Print "Passed: TrimRightTest" 220 | End If 221 | 222 | If Not CountUppercaseCharactersTest() Then 223 | Debug.Print "Failed: CountUppercaseCharactersTest" 224 | TestStatus = False 225 | Else 226 | Debug.Print "Passed: CountUppercaseCharactersTest" 227 | End If 228 | 229 | If Not CountLowercaseCharactersTest() Then 230 | Debug.Print "Failed: CountLowercaseCharactersTest" 231 | TestStatus = False 232 | Else 233 | Debug.Print "Passed: CountLowercaseCharactersTest" 234 | End If 235 | 236 | If Not TextJoinTest() Then 237 | Debug.Print "Failed: TextJoinTest" 238 | TestStatus = False 239 | Else 240 | Debug.Print "Passed: TextJoinTest" 241 | End If 242 | ' End Tests 243 | 244 | Debug.Print "----------------------------------------" 245 | 246 | If TestStatus Then 247 | Debug.Print "Passed All Tests" 248 | Else 249 | Debug.Print "!!! FAILED TESTS !!!" 250 | End If 251 | 252 | Debug.Print "========================================" 253 | 254 | AllXlibStringManipulationTests = TestStatus 255 | 256 | End Function 257 | 258 | 259 | 260 | Private Function CapitalizeTest() As Boolean 261 | 262 | '@Example: =Capitalize("hello World") -> "Hello world" 263 | 264 | CapitalizeTest = True 265 | 266 | CapitalizeTest = CapitalizeTest And Capitalize("hello World") = "Hello world" 267 | 268 | End Function 269 | 270 | 271 | Private Function LeftFindTest() As Boolean 272 | 273 | '@Example: =LeftFind("Hello World", "r") -> "Hello Wo" 274 | '@Example: =LeftFind("Hello World", "R") -> "#VALUE!"; Since string1 does not contain "R" in it. 275 | 276 | LeftFindTest = True 277 | 278 | LeftFindTest = LeftFindTest And LeftFind("Hello World", "r") = "Hello Wo" 279 | 280 | End Function 281 | 282 | 283 | Private Function RightFindTest() As Boolean 284 | 285 | '@Example: =RightFind("Hello World", "o") -> "rld" 286 | '@Example: =RightFind("Hello World", "O") -> "#VALUE!"; Since string1 does not contain "O" in it. 287 | 288 | RightFindTest = True 289 | 290 | RightFindTest = RightFindTest And RightFind("Hello World", "o") = "rld" 291 | 292 | End Function 293 | 294 | 295 | Private Function LeftSearchTest() As Boolean 296 | 297 | '@Example: =LeftSearch("Hello World", "r") -> "Hello Wo" 298 | '@Example: =LeftSearch("Hello World", "R") -> "Hello Wo" 299 | 300 | LeftSearchTest = True 301 | 302 | LeftSearchTest = LeftSearchTest And LeftSearch("Hello World", "r") = "Hello Wo" 303 | LeftSearchTest = LeftSearchTest And LeftSearch("Hello World", "R") = "Hello Wo" 304 | 305 | End Function 306 | 307 | 308 | Private Function RightSearchTest() As Boolean 309 | 310 | '@Example: =RightSearch("Hello World", "o") -> "rld" 311 | '@Example: =RightSearch("Hello World", "O") -> "rld" 312 | 313 | RightSearchTest = True 314 | 315 | RightSearchTest = RightSearchTest And RightSearch("Hello World", "o") = "rld" 316 | RightSearchTest = RightSearchTest And RightSearch("Hello World", "O") = "rld" 317 | 318 | End Function 319 | 320 | 321 | Private Function SubstrTest() As Boolean 322 | 323 | '@Example: =Substr("Hello World", 2, 6) -> "ello" 324 | 325 | SubstrTest = True 326 | 327 | SubstrTest = SubstrTest And Substr("Hello World", 2, 6) = "ello" 328 | 329 | End Function 330 | 331 | 332 | Private Function SubstrFindTest() As Boolean 333 | 334 | '@Example: =SubstrFind("Hello World", "e", "o") -> "ello Wo" 335 | '@Example: =SubstrFind("Hello World", "e", "o", TRUE) -> "llo W" 336 | '@Example: =SubstrFind("One Two Three", "ne ", " Thr") -> "ne Two Thr" 337 | '@Example: =SubstrFind("One Two Three", "NE ", " THR") -> "#VALUE!"; Since SubstrFind() is case-sensitive 338 | '@Example: =SubstrFind("One Two Three", "ne ", " Thr", TRUE) -> "Two" 339 | '@Example: =SubstrFind("Country Code: +51; Area Code: 315; Phone Number: 762-5929;", "Area Code: ", "; Phone", TRUE) -> 315 340 | '@Example: =SubstrFind("Country Code: +313; Area Code: 423; Phone Number: 284-2468;", "Area Code: ", "; Phone", TRUE) -> 423 341 | '@Example: =SubstrFind("Country Code: +171; Area Code: 629; Phone Number: 731-5456;", "Area Code: ", "; Phone", TRUE) -> 629 342 | 343 | SubstrFindTest = True 344 | 345 | SubstrFindTest = SubstrFindTest And SubstrFind("Hello World", "e", "o") = "ello Wo" 346 | SubstrFindTest = SubstrFindTest And SubstrFind("Hello World", "e", "o", True) = "llo W" 347 | SubstrFindTest = SubstrFindTest And SubstrFind("One Two Three", "ne ", " Thr") = "ne Two Thr" 348 | SubstrFindTest = SubstrFindTest And SubstrFind("One Two Three", "ne ", " Thr", True) = "Two" 349 | 350 | End Function 351 | 352 | 353 | Private Function SubstrSearchTest() As Boolean 354 | 355 | '@Example: =SubstrSearch("Hello World", "e", "o") -> "ello Wo" 356 | '@Example: =SubstrSearch("Hello World", "e", "o", TRUE) -> "llo W" 357 | '@Example: =SubstrSearch("One Two Three", "ne ", " Thr") -> "ne Two Thr" 358 | '@Example: =SubstrSearch("One Two Three", "NE ", " THR") -> "ne Two Thr"; No error, since SubstrSearch is case-insensitive 359 | '@Example: =SubstrSearch("One Two Three", "ne ", " Thr", TRUE) -> "Two" 360 | '@Example: =SubstrSearch("Country Code: +51; Area Code: 315; Phone Number: 762-5929;", "Area Code: ", "; Phone", TRUE) -> 315 361 | '@Example: =SubstrSearch("Country Code: +313; Area Code: 423; Phone Number: 284-2468;", "Area Code: ", "; Phone", TRUE) -> 423 362 | '@Example: =SubstrSearch("Country Code: +171; Area Code: 629; Phone Number: 731-5456;", "Area Code: ", "; Phone", TRUE) -> 629 363 | 364 | SubstrSearchTest = True 365 | 366 | SubstrSearchTest = SubstrSearchTest And SubstrSearch("Hello World", "e", "o") = "ello Wo" 367 | SubstrSearchTest = SubstrSearchTest And SubstrSearch("Hello World", "e", "o", True) = "llo W" 368 | SubstrSearchTest = SubstrSearchTest And SubstrSearch("One Two Three", "ne ", " Thr") = "ne Two Thr" 369 | SubstrSearchTest = SubstrSearchTest And SubstrSearch("One Two Three", "NE ", " THR") = "ne Two Thr" 370 | SubstrSearchTest = SubstrSearchTest And SubstrSearch("One Two Three", "ne ", " Thr", True) = "Two" 371 | 372 | End Function 373 | 374 | 375 | Private Function RepeatTest() As Boolean 376 | 377 | '@Example: =Repeat("Hello", 2) -> HelloHello" 378 | '@Example: =Repeat("=", 10) -> "==========" 379 | 380 | RepeatTest = True 381 | 382 | RepeatTest = RepeatTest And Repeat("Hello", 2) = "HelloHello" 383 | RepeatTest = RepeatTest And Repeat("=", 10) = "==========" 384 | 385 | End Function 386 | 387 | 388 | Private Function FormatterTest() As Boolean 389 | 390 | '@Example: =Formatter("Hello {1}", "World") -> "Hello World" 391 | '@Example: =Formatter("{1} {2}", "Hello", "World") -> "Hello World" 392 | '@Example: =Formatter("{1}.{2}@{3}", "FirstName", "LastName", "email.com") -> "FirstName.LastName@email.com" 393 | '@Example: =Formatter("{1}.{2}@{3}", A1:A3) -> "FirstName.LastName@email.com"; where A1="FirstName", A2="LastName", and A3="email.com" 394 | '@Example: =Formatter("{1}.{2}@{3}", A1, A2, A3) -> "FirstName.LastName@email.com"; where A1="FirstName", A2="LastName", and A3="email.com" 395 | 396 | FormatterTest = True 397 | 398 | FormatterTest = FormatterTest And Formatter("Hello {1}", "World") = "Hello World" 399 | FormatterTest = FormatterTest And Formatter("{1} {2}", "Hello", "World") = "Hello World" 400 | FormatterTest = FormatterTest And Formatter("{1}.{2}@{3}", "FirstName", "LastName", "email.com") = "FirstName.LastName@email.com" 401 | FormatterTest = FormatterTest And Formatter("{1}.{2}@{3}", Array("FirstName", "LastName", "email.com")) = "FirstName.LastName@email.com" 402 | 403 | End Function 404 | 405 | 406 | Private Function ZfillTest() As Boolean 407 | 408 | '@Example: =Zfill(123, 5) -> "00123" 409 | '@Example: =Zfill(5678, 5) -> "05678" 410 | '@Example: =Zfill(12345678, 5) -> "12345678" 411 | '@Example: =Zfill(123, 5, "X") -> "XX123" 412 | '@Example: =Zfill(123, 5, "X", TRUE) -> "123XX" 413 | 414 | ZfillTest = True 415 | 416 | ZfillTest = ZfillTest And Zfill(123, 5) = "00123" 417 | ZfillTest = ZfillTest And Zfill(5678, 5) = "05678" 418 | ZfillTest = ZfillTest And Zfill(12345678, 5) = "12345678" 419 | ZfillTest = ZfillTest And Zfill(123, 5, "X") = "XX123" 420 | ZfillTest = ZfillTest And Zfill(123, 5, "X", True) = "123XX" 421 | 422 | End Function 423 | 424 | 425 | Private Function SplitTextTest() As Boolean 426 | 427 | '@Example: =SplitText("Hello World", 1) -> "Hello" 428 | '@Example: =SplitText("Hello World", 2) -> "World" 429 | '@Example: =SplitText("One Two Three", 2) -> "Two" 430 | '@Example: =SplitText("One-Two-Three", 2, "-") -> "Two" 431 | 432 | SplitTextTest = True 433 | 434 | SplitTextTest = SplitTextTest And SplitText("Hello World", 1) = "Hello" 435 | SplitTextTest = SplitTextTest And SplitText("Hello World", 2) = "World" 436 | SplitTextTest = SplitTextTest And SplitText("One Two Three", 2) = "Two" 437 | SplitTextTest = SplitTextTest And SplitText("One-Two-Three", 2, "-") = "Two" 438 | 439 | End Function 440 | 441 | 442 | Private Function CountWordsTest() As Boolean 443 | 444 | '@Example: =CountWords("Hello World") -> 2 445 | '@Example: =CountWords("One Two Three") -> 3 446 | '@Example: =CountWords("One-Two-Three", "-") -> 3 447 | 448 | CountWordsTest = True 449 | 450 | CountWordsTest = CountWordsTest And CountWords("Hello World") = 2 451 | CountWordsTest = CountWordsTest And CountWords("One Two Three") = 3 452 | CountWordsTest = CountWordsTest And CountWords("One-Two-Three", "-") = 3 453 | 454 | End Function 455 | 456 | 457 | Private Function CamelCaseTest() As Boolean 458 | 459 | '@Example: =CamelCase("Hello World") -> "helloWorld" 460 | '@Example: =CamelCase("One Two Three") -> "oneTwoThree" 461 | 462 | CamelCaseTest = True 463 | 464 | CamelCaseTest = CamelCaseTest And CamelCase("Hello World") = "helloWorld" 465 | CamelCaseTest = CamelCaseTest And CamelCase("One Two Three") = "oneTwoThree" 466 | 467 | End Function 468 | 469 | 470 | Private Function KebabCaseTest() As Boolean 471 | 472 | '@Example: =KebabCase("Hello World") -> "hello-world" 473 | '@Example: =KebabCase("One Two Three") -> "one-two-three" 474 | 475 | KebabCaseTest = True 476 | 477 | KebabCaseTest = KebabCaseTest And KebabCase("Hello World") = "hello-world" 478 | KebabCaseTest = KebabCaseTest And KebabCase("One Two Three") = "one-two-three" 479 | 480 | End Function 481 | 482 | 483 | Private Function RemoveCharactersTest() As Boolean 484 | 485 | '@Example: =RemoveCharacters("Hello World", "l") -> "Heo Word" 486 | '@Example: =RemoveCharacters("Hello World", "lo") -> "He Wrd" 487 | '@Example: =RemoveCharacters("Hello World", "l", "o") -> "He Wrd" 488 | '@Example: =RemoveCharacters("Hello World", "lod") -> "He Wr" 489 | '@Example: =RemoveCharacters("One Two Three", "o", "t") -> "One Two Three"; Nothing is replaced since this function is case sensitive 490 | '@Example: =RemoveCharacters("One Two Three", "O", "T") -> "ne wo hree" 491 | 492 | RemoveCharactersTest = True 493 | 494 | RemoveCharactersTest = RemoveCharactersTest And RemoveCharacters("Hello World", "l") = "Heo Word" 495 | RemoveCharactersTest = RemoveCharactersTest And RemoveCharacters("Hello World", "lo") = "He Wrd" 496 | RemoveCharactersTest = RemoveCharactersTest And RemoveCharacters("Hello World", "l", "o") = "He Wrd" 497 | RemoveCharactersTest = RemoveCharactersTest And RemoveCharacters("Hello World", "lod") = "He Wr" 498 | RemoveCharactersTest = RemoveCharactersTest And RemoveCharacters("Two Three Four", "f", "t") = "Two Three Four" 499 | RemoveCharactersTest = RemoveCharactersTest And RemoveCharacters("Two Three Four", "F", "T") = "wo hree our" 500 | 501 | End Function 502 | 503 | 504 | Private Function CompanyCaseTest() As Boolean 505 | 506 | '@Example: =CompanyCase("hello world") -> "Hello World" 507 | '@Example: =CompanyCase("x.y.z company & co.") -> "X.Y.Z Company & Co." 508 | '@Example: =CompanyCase("x.y.z plc") -> "X.Y.Z PLC" 509 | '@Example: =CompanyCase("one company gmbh") -> "One Company GmbH" 510 | '@Example: =CompanyCase("three company s. en n.c.") -> "Three Company S. en N.C." 511 | '@Example: =CompanyCase("FOUR COMPANY SPOL S.R.O.") -> "Four Company spol s.r.o." 512 | '@Example: =CompanyCase("five company bvba") -> "Five Company BVBA" 513 | 514 | CompanyCaseTest = True 515 | 516 | CompanyCaseTest = CompanyCaseTest And CompanyCase("hello world") = "Hello World" 517 | CompanyCaseTest = CompanyCaseTest And CompanyCase("x.y.z company & co.") = "X.Y.Z Company & Co." 518 | CompanyCaseTest = CompanyCaseTest And CompanyCase("x.y.z plc") = "X.Y.Z PLC" 519 | CompanyCaseTest = CompanyCaseTest And CompanyCase("one company gmbh") = "One Company GmbH" 520 | CompanyCaseTest = CompanyCaseTest And CompanyCase("three company s. en n.c.") = "Three Company S. en N.C." 521 | CompanyCaseTest = CompanyCaseTest And CompanyCase("FOUR COMPANY SPOL S.R.O.") = "Four Company spol s.r.o." 522 | CompanyCaseTest = CompanyCaseTest And CompanyCase("five company bvba") = "Five Company BVBA" 523 | 524 | End Function 525 | 526 | 527 | Private Function ReverseTextTest() As Boolean 528 | 529 | '@Example: =ReverseText("Hello World") -> "dlroW olleH" 530 | 531 | ReverseTextTest = True 532 | 533 | ReverseTextTest = ReverseTextTest And ReverseText("Hello World") = "dlroW olleH" 534 | 535 | End Function 536 | 537 | 538 | Private Function ReverseWordsTest() As Boolean 539 | 540 | '@Example: =ReverseWords("Hello World") -> "World Hello" 541 | '@Example: =ReverseWords("One Two Three") -> "Three Two One" 542 | '@Example: =ReverseWords("One-Two-Three", "-") -> "Three-Two-One" 543 | 544 | ReverseWordsTest = True 545 | 546 | ReverseWordsTest = ReverseWordsTest And ReverseWords("Hello World") = "World Hello" 547 | ReverseWordsTest = ReverseWordsTest And ReverseWords("One Two Three") = "Three Two One" 548 | ReverseWordsTest = ReverseWordsTest And ReverseWords("One-Two-Three", "-") = "Three-Two-One" 549 | 550 | End Function 551 | 552 | 553 | Private Function IndentTextTest() As Boolean 554 | 555 | '@Example: =IndentText("Hello") -> " Hello" 556 | '@Example: =IndentText("Hello", 4) -> " Hello" 557 | '@Example: =IndentText("Hello", 3) -> " Hello" 558 | '@Example: =IndentText("Hello", 2) -> " Hello" 559 | '@Example: =IndentText("Hello", 1) -> " Hello" 560 | 561 | IndentTextTest = True 562 | 563 | IndentTextTest = IndentTextTest And IndentText("Hello") = " Hello" 564 | IndentTextTest = IndentTextTest And IndentText("Hello", 4) = " Hello" 565 | IndentTextTest = IndentTextTest And IndentText("Hello", 3) = " Hello" 566 | IndentTextTest = IndentTextTest And IndentText("Hello", 2) = " Hello" 567 | IndentTextTest = IndentTextTest And IndentText("Hello", 1) = " Hello" 568 | 569 | End Function 570 | 571 | 572 | Private Function DedentTextTest() As Boolean 573 | 574 | '@Example: =DedentText(" Hello") -> "Hello" 575 | 576 | DedentTextTest = True 577 | 578 | DedentTextTest = DedentTextTest And DedentText(" Hello") = "Hello" 579 | 580 | End Function 581 | 582 | 583 | Private Function ShortenTextTest() As Boolean 584 | 585 | '@Example: =ShortenText("Hello World One Two Three", 20) -> "Hello World [...]"; Only the first two words and the placeholder will result in a string that is less than or equal to 20 in length 586 | '@Example: =ShortenText("Hello World One Two Three", 15) -> "Hello [...]"; Only the first word and the placeholder will result in a string that is less than or equal to 15 in length 587 | '@Example: =ShortenText("Hello World One Two Three") -> "Hello World One Two Three"; Since this string is shorter than the default 80 shorten width value, no placeholder will be used and the string wont be shortened 588 | '@Example: =ShortenText("Hello World One Two Three", 15, "-->") -> "Hello World -->"; A new placeholder is used 589 | '@Example: =ShortenText("Hello_World_One_Two_Three", 15, "-->", "_") -> "Hello_World_-->"; A new placeholder andd delimiter is used 590 | 591 | ShortenTextTest = True 592 | 593 | ShortenTextTest = ShortenTextTest And ShortenText("Hello World One Two Three", 20) = "Hello World [...]" 594 | ShortenTextTest = ShortenTextTest And ShortenText("Hello World One Two Three", 15) = "Hello [...]" 595 | ShortenTextTest = ShortenTextTest And ShortenText("Hello World One Two Three") = "Hello World One Two Three" 596 | ShortenTextTest = ShortenTextTest And ShortenText("Hello World One Two Three", 15, "-->") = "Hello World -->" 597 | ShortenTextTest = ShortenTextTest And ShortenText("Hello_World_One_Two_Three", 15, "-->", "_") = "Hello_World_-->" 598 | 599 | End Function 600 | 601 | 602 | Private Function InSplitTest() As Boolean 603 | 604 | '@Example: =InSplit("Hello", "Hello World One Two Three") -> TRUE; Since "Hello" is found within the searchString after being split 605 | '@Example: =InSplit("NotInString", "Hello World One Two Three") -> FALSE; Since "NotInString" is not found within the searchString after being split 606 | '@Example: =InSplit("Hello", "Hello-World-One-Two-Three", "-") -> TRUE; Since "Hello" is found and since the delimiter is set to "-" 607 | 608 | InSplitTest = True 609 | 610 | InSplitTest = InSplitTest And InSplit("Hello", "Hello World One Two Three") = True 611 | InSplitTest = InSplitTest And InSplit("NotInString", "Hello World One Two Three") = False 612 | InSplitTest = InSplitTest And InSplit("Hello", "Hello-World-One-Two-Three", "-") = True 613 | 614 | End Function 615 | 616 | 617 | Private Function EliteCaseTest() As Boolean 618 | 619 | '@Example: =EliteCase("Hello World") -> "H3110 W0r1d" 620 | 621 | EliteCaseTest = True 622 | 623 | EliteCaseTest = EliteCaseTest And EliteCase("Hello World") = "H3110 W0r1d" 624 | 625 | End Function 626 | 627 | 628 | Private Function ScrambleCaseTest() As Boolean 629 | 630 | '@Example: =ScrambleCase("Hello World") -> "helLo WORlD" 631 | '@Example: =ScrambleCase("Hello World") -> "HElLo WorLD" 632 | '@Example: =ScrambleCase("Hello World") -> "hELlo WOrLd" 633 | 634 | ScrambleCaseTest = True 635 | 636 | Dim testString As String 637 | testString = "a" 638 | 639 | ScrambleCaseTest = ScrambleCaseTest And (testString = "a" Or testString = "A") 640 | 641 | End Function 642 | 643 | 644 | Private Function LeftSplitTest() As Boolean 645 | 646 | '@Example: =LeftSplit("Hello World One Two Three", 1) -> "Hello" 647 | '@Example: =LeftSplit("Hello World One Two Three", 2) -> "Hello World" 648 | '@Example: =LeftSplit("Hello World One Two Three", 3) -> "Hello World One" 649 | '@Example: =LeftSplit("Hello World One Two Three", 10) -> "Hello World One Two Three" 650 | '@Example: =LeftSplit("Hello-World-One-Two-Three", 2, "-") -> "Hello-World" 651 | 652 | LeftSplitTest = True 653 | 654 | LeftSplitTest = LeftSplitTest And LeftSplit("Hello World One Two Three", 1) = "Hello" 655 | LeftSplitTest = LeftSplitTest And LeftSplit("Hello World One Two Three", 2) = "Hello World" 656 | LeftSplitTest = LeftSplitTest And LeftSplit("Hello World One Two Three", 3) = "Hello World One" 657 | LeftSplitTest = LeftSplitTest And LeftSplit("Hello World One Two Three", 10) = "Hello World One Two Three" 658 | LeftSplitTest = LeftSplitTest And LeftSplit("Hello-World-One-Two-Three", 2, "-") = "Hello-World" 659 | 660 | End Function 661 | 662 | 663 | Private Function RightSplitTest() As Boolean 664 | 665 | '@Example: =RightSplit("Hello World One Two Three", 1) -> "Three" 666 | '@Example: =RightSplit("Hello World One Two Three", 2) -> "Two Three" 667 | '@Example: =RightSplit("Hello World One Two Three", 3) -> "One Two Three" 668 | '@Example: =RightSplit("Hello World One Two Three", 10) -> "Hello World One Two Three" 669 | '@Example: =RightSplit("Hello-World-One-Two-Three", 2, "-") -> "Two-Three" 670 | 671 | RightSplitTest = True 672 | 673 | RightSplitTest = RightSplitTest And RightSplit("Hello World One Two Three", 1) = "Three" 674 | RightSplitTest = RightSplitTest And RightSplit("Hello World One Two Three", 2) = "Two Three" 675 | RightSplitTest = RightSplitTest And RightSplit("Hello World One Two Three", 3) = "One Two Three" 676 | RightSplitTest = RightSplitTest And RightSplit("Hello World One Two Three", 10) = "Hello World One Two Three" 677 | RightSplitTest = RightSplitTest And RightSplit("Hello-World-One-Two-Three", 2, "-") = "Two-Three" 678 | 679 | End Function 680 | 681 | 682 | Private Function TrimCharTest() As Boolean 683 | 684 | '@Example: =TrimChar(" Hello World ") -> "Hello World" 685 | '@Example: =TrimChar("---Hello World---", "-") -> "Hello World" 686 | 687 | TrimCharTest = True 688 | 689 | TrimCharTest = TrimCharTest And TrimChar(" Hello World ") = "Hello World" 690 | TrimCharTest = TrimCharTest And TrimChar("---Hello World---", "-") = "Hello World" 691 | 692 | End Function 693 | 694 | 695 | Private Function TrimLeftTest() As Boolean 696 | 697 | '@Example: =TrimLeft(" Hello World ") -> "Hello World " 698 | '@Example: =TrimLeft("---Hello World---", "-") -> "Hello World---" 699 | 700 | TrimLeftTest = True 701 | 702 | TrimLeftTest = TrimLeftTest And TrimLeft(" Hello World ") = "Hello World " 703 | TrimLeftTest = TrimLeftTest And TrimLeft("---Hello World---", "-") = "Hello World---" 704 | 705 | End Function 706 | 707 | 708 | Private Function TrimRightTest() As Boolean 709 | 710 | '@Example: =TrimRight(" Hello World ") -> " Hello World" 711 | '@Example: =TrimRight("---Hello World---", "-") -> "---Hello World" 712 | 713 | TrimRightTest = True 714 | 715 | TrimRightTest = TrimRightTest And TrimRight(" Hello World ") = " Hello World" 716 | TrimRightTest = TrimRightTest And TrimRight("---Hello World---", "-") = "---Hello World" 717 | 718 | End Function 719 | 720 | 721 | Private Function CountUppercaseCharactersTest() As Boolean 722 | 723 | '@Example: =CountUppercaseCharacters("Hello World") -> 2; As the "H" and the "E" are the only 2 uppercase characters in the string 724 | 725 | CountUppercaseCharactersTest = True 726 | 727 | CountUppercaseCharactersTest = CountUppercaseCharactersTest And CountUppercaseCharacters("Hello World") = 2 728 | 729 | End Function 730 | 731 | 732 | Private Function CountLowercaseCharactersTest() As Boolean 733 | 734 | '@Example: =CountLowercaseCharacters("Hello World") -> 8; As the "ello" and the "orld" are lowercase 735 | 736 | CountLowercaseCharactersTest = True 737 | 738 | CountLowercaseCharactersTest = CountLowercaseCharactersTest And CountLowercaseCharacters("Hello World") = 8 739 | 740 | End Function 741 | 742 | 743 | Private Function TextJoinTest() As Boolean 744 | 745 | '@Example: =TextJoin(A1:A3) -> "123"; Where A1:A3 contains ["1", "2", "3"] 746 | '@Example: =TextJoin(A1:A3, "--") -> "1--2--3"; Where A1:A3 contains ["1", "2", "3"] 747 | '@Example: =TextJoin(A1:A3, "--") -> "1----3"; Where A1:A3 contains ["1", "", "3"] 748 | '@Example: =TextJoin(A1:A3, "-") -> "1--3"; Where A1:A3 contains ["1", "", "3"] 749 | '@Example: =TextJoin(A1:A3, "-", TRUE) -> "1-3"; Where A1:A3 contains ["1", "", "3"] 750 | 751 | TextJoinTest = True 752 | 753 | TextJoinTest = TextJoinTest And TextJoin(Array("1", "2", "3")) = "123" 754 | TextJoinTest = TextJoinTest And TextJoin(Array("1", "2", "3"), "--") = "1--2--3" 755 | TextJoinTest = TextJoinTest And TextJoin(Array("1", "", "3"), "--") = "1----3" 756 | TextJoinTest = TextJoinTest And TextJoin(Array("1", "", "3"), "-") = "1--3" 757 | TextJoinTest = TextJoinTest And TextJoin(Array("1", "", "3"), "-", True) = "1-3" 758 | 759 | End Function 760 | 761 | 762 | --------------------------------------------------------------------------------