Sub CapitalizeAcronyms2(c As Range)
Dim myStringArray() As String
Dim AcronymToFind As String
Dim i As Long, r As Long
Dim lastRow1 As Long
Dim lastRow2 As Long
Dim lastRow3 As Long
Dim lastRow4 As Long
Dim lastRow5 As Long
Dim lastRow6 As Long
Dim lastRow7 As Long
Dim SplitArr() As String
On Error Resume Next
myStringArray() = Split(c, " ")
lastRow1 = Sheets("A1 Acronyms").UsedRange.Rows.count
lastRow2 = Sheets("A2 Acronyms").Range("B" & Rows.count).End(xlUp).Row
lastRow3 = Sheets("C1 Acronyms").Range("B" & Rows.count).End(xlUp).Row
lastRow4 = Sheets("E1 Acronyms").Range("B" & Rows.count).End(xlUp).Row
lastRow5 = Sheets("E2 Acronyms").Range("B" & Rows.count).End(xlUp).Row
lastRow6 = Sheets("E3 Acronyms").Range("B" & Rows.count).End(xlUp).Row
lastRow7 = Sheets("Misc Acronyms").Range("B" & Rows.count).End(xlUp).Row
For i = LBound(myStringArray) To UBound(myStringArray)
With c
For r = 4 To lastRow1
AcronymToFind = Sheets("A1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "," Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow2
AcronymToFind = Sheets("A2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "," Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow3
AcronymToFind = Sheets("C1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "," Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow4
AcronymToFind = Sheets("E1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "," Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow5
AcronymToFind = Sheets("E2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "," Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow6
AcronymToFind = Sheets("E3 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "," Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow7
AcronymToFind = Sheets("Misc Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "," Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
End With
Next i
ReDim myStringArray(UBound(myStringArray))
myStringArray() = Split(c, " ")
For i = LBound(myStringArray) To UBound(myStringArray)
With c
For r = 4 To lastRow1
AcronymToFind = Sheets("A1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "." Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow2
AcronymToFind = Sheets("A2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "." Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow3
AcronymToFind = Sheets("C1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "." Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow4
AcronymToFind = Sheets("E1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "." Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow5
AcronymToFind = Sheets("E2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "." Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow6
AcronymToFind = Sheets("E3 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "." Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow7
AcronymToFind = Sheets("Misc Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "." Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
End With
Next i
ReDim myStringArray(UBound(myStringArray))
myStringArray() = Split(c, " ")
For i = LBound(myStringArray) To UBound(myStringArray)
With c
For r = 4 To lastRow1
AcronymToFind = Sheets("A1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ":" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow2
AcronymToFind = Sheets("A2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ":" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow3
AcronymToFind = Sheets("C1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ":" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow4
AcronymToFind = Sheets("E1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ":" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow5
AcronymToFind = Sheets("E2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ":" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow6
AcronymToFind = Sheets("E3 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ":" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow7
AcronymToFind = Sheets("Misc Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ":" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
End With
Next i
ReDim myStringArray(UBound(myStringArray))
myStringArray() = Split(c, " ")
For i = LBound(myStringArray) To UBound(myStringArray)
With c
For r = 4 To lastRow1
AcronymToFind = Sheets("A1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ";" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow2
AcronymToFind = Sheets("A2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ";" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow3
AcronymToFind = Sheets("C1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ";" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow4
AcronymToFind = Sheets("E1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ";" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow5
AcronymToFind = Sheets("E2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ";" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow6
AcronymToFind = Sheets("E3 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ";" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow7
AcronymToFind = Sheets("Misc Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & ";" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
End With
Next i
ReDim myStringArray(UBound(myStringArray))
myStringArray() = Split(c, " ")
For i = LBound(myStringArray) To UBound(myStringArray)
With c
For r = 4 To lastRow1
AcronymToFind = Sheets("A1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "?" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow2
AcronymToFind = Sheets("A2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "?" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow3
AcronymToFind = Sheets("C1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "?" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow4
AcronymToFind = Sheets("E1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "?" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow5
AcronymToFind = Sheets("E2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "?" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow6
AcronymToFind = Sheets("E3 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "?" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow7
AcronymToFind = Sheets("Misc Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "?" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
End With
Next i
ReDim myStringArray(UBound(myStringArray))
myStringArray() = Split(c, " ")
For i = LBound(myStringArray) To UBound(myStringArray)
With c
For r = 4 To lastRow1
AcronymToFind = Sheets("A1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "!" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow2
AcronymToFind = Sheets("A2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "!" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow3
AcronymToFind = Sheets("C1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "!" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow4
AcronymToFind = Sheets("E1 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "!" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow5
AcronymToFind = Sheets("E2 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "!" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow6
AcronymToFind = Sheets("E3 Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "!" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
For r = 3 To lastRow7
AcronymToFind = Sheets("Misc Acronyms").Range("B" & r).Value
If UCase(myStringArray(i)) = AcronymToFind Or UCase(myStringArray(i)) = AcronymToFind & "!" Then
myStringArray(i) = UCase(myStringArray(i))
.Value = Join(myStringArray, " ")
End If
Next r
End With
Next i
a:
End Sub