The below code I have on an Excel sheet. I am using VBA to alter the contents of certain cells in order to format them correctly for my job. We keep a list of damages, bay locations, and VINs. Each one of these columns has their own certain formats, and for 2 of them I have working fine. Some of you may recognize some of this code from another post I had about getting the damage codes formatted correctly. The columns are ordered as such
Bay Location | VIN | Damage Code(s)
For VIN, all we do is upper-case the letters. Simple, got that done. The damage codes function works perfectly after I've altered it a bit to better suit my needs. Could not have done that without the original help I received here. Here's where things get weird, my boss, seeing that I had gotten this to work for the damage codes, asked me to get it to Auto-Format the bays. The bay locations at my job have a few possibilities, but there is always at least 1 letter in front such as
- H-5
- H-125
- HH-50
- 7A-70
- FNCE-13
In English, what I want done is this: Input unformatted bay, such as 7a12, uppercase the letters, split it by the numbers, and add a dash in between the two groups, and voila.
I had this working, even showed it to my boss. But then I added in the code to uppercase the VIN column and I started getting an error, highlighting the line
Set allMatches = RE1.Execute(strSource)
The RE1.test(strSource) runs fine, but trying to grab the matches/submatches now mysteriously throws an error. I originally used the text from This StackOverflow question to get it working. The error I get is something akin to it telling me that the object isn't set. I know the code is currently a mess, I had to leave mid-work (figured maybe something was wrong with my function, nope, same error when being ran directly from the original sub function).
Edit: The Error is as followed
Run Time Error '91' Object Variable or With block variable not set
And again, it highlights
allMatches = RE.Execute(str)
Any help is appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim str As String, result As String
Dim RE As Object
Dim allMatches As Object
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Application.Union(Range("F3:F100"), Range("C3:C100"), Range("I3:I100"))
Set RE = CreateObject("vbscript.regexp")
If Not TypeName(Target.Value) = "Variant()" Then
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
str = ConvertString(Target)
If (Not str = Target.Value And Not Target.Value = "") Then
Target.Value = str
End If
End If
' Now we have to check the bays in order to auto format
Set KeyCells = Application.Union(Range("A3:A100"), Range("D3:D100"), Range("G3:G100"))
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
RE.Pattern = "([0-9]?[A-Z]{1,})\-?([0-9]{1,3})"
RE.Global = True
If Not Target.Value = "" And Not RE.test(Target.Value) Then
str = CStr(Target.Value)
RE.IgnoreCase = True
allMatches = RE.Execute(str)
MsgBox allMatches.Count
Target.Value = str
End If
End If
Set KeyCells = Application.Union(Range("B3:B100"), Range("E3:E100"), Range("H3:H100"))
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
RE.Pattern = "[a-z]?"
RE.IgnoreCase = False
If RE.test(Target.Value) Then
Target.Value = UCase(Target.Value)
End If
End If
End If
End Sub
Function FormatBay(str1 As Range) As String
Dim result As String, strSource As String
Dim allMatches As Object
Dim RE1 As Object
Set RE1 = CreateObject("vbscript.regexp")
RE1.Pattern = "([0-9]?[A-Z]{1,})\-?([0-9]{1,3})"
RE1.Global = True
strSource = CStr(str1.Value)
Set allMatches = RE1.Execute(strSource)
result = "FF-12"
If allMatches.Count <> 0 Then
result = allMatches.Item(0)
End If
MsgBox result
FormatBay = result
End Function
Function ConvertString(str1 As Range) As String
Dim varStr As Variant
Dim strSource As String, strResult As String
Dim i As Integer
For Each varStr In Split(Trim(str1.Value), " ")
strSource = CStr(varStr)
If InStr(strSource, ".") = 0 Then
strResult = strResult & _
Mid(strSource, 1, 2) & "." & _
Mid(strSource, 3, 2) & "." & _
Mid(strSource, 5, 1)
If Len(strSource) > 5 Then
strResult = strResult & "("
For i = 6 To Len(strSource)
strResult = strResult & Mid(strSource, i, 1) & ","
Next i
strResult = Left(strResult, Len(strResult) - 1) & ")"
End If
strResult = strResult & " "
Else
strResult = strResult & strSource & " "
End If
Next
If strResult = "" Then
ConvertString = ""
Else
ConvertString = Left(strResult, Len(strResult) - 1)
End If
End Function
EDIT : Here is what I got to work, I know it's sort of long and probably verbose, but I'm just learning VBA so when I learn a better way to do it, I will edit this post in the hopes of helping someone later.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim str As String, result As String
Dim RE As Object
Dim allMatches As Object
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Application.Union(Range("F3:F100"), Range("C3:C100"), Range("I3:I100"))
Set RE = CreateObject("vbscript.regexp")
If Not TypeName(Target.Value) = "Variant()" Then
' Now we have to check the bays in order to auto format
Set KeyCells = Application.Union(Range("A3:A100"), Range("D3:D100"), Range("G3:G100"))
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
RE.Pattern = "([0-9]?[A-Z]{1,})\-?([0-9]{1,3})"
RE.Global = True
If Not Target.Value = "" And Not RE.test(Target.Value) Then
str = CStr(Target.Value)
str = FormatBay(str)
Target.Value = str
End If
End If
Set KeyCells = Application.Union(Range("B3:B100"), Range("E3:E100"), Range("H3:H100"))
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
RE.Pattern = "[a-z]?"
RE.IgnoreCase = False
If RE.test(Target.Value) Then
Target.Value = UCase(Target.Value)
End If
End If
Set KeyCells = Application.Union(Range("C3:C100"), Range("F3:F100"), Range("I3:I100"))
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
str = ConvertString(Target)
If (Not str = Target.Value And Not Target.Value = "") Then
Target.Value = str
End If
End If
End If
End Sub
Function FormatBay(ByVal text As String) As String
Dim result As String, bayLetter As String, bayNumber As String
Dim length As Integer, i As Integer
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "([0-9]?[a-z]{1,})\-?([0-9]{1,3})"
RE.Global = True
RE.IgnoreCase = True
Set allMatches = RE.Execute(text)
If Not allMatches.Count = 0 Then
bayLocation = allMatches.Item(0).submatches.Item(0)
bayLocation = UCase(bayLocation)
bayNumber = allMatches.Item(0).submatches.Item(1)
length = Len(bayNumber)
For i = 1 To (3 - length)
bayNumber = "0" & bayNumber
Next
result = bayLocation & "-" & bayNumber
End If
FormatBay = result
End Function
Function ConvertString(str1 As Range) As String
Dim varStr As Variant
Dim strSource As String, strResult As String
Dim i As Integer
For Each varStr In Split(Trim(str1.Value), " ")
strSource = CStr(varStr)
If InStr(strSource, ".") = 0 And IsNumeric(strSource) Then
strResult = strResult & _
Mid(strSource, 1, 2) & "." & _
Mid(strSource, 3, 2) & "." & _
Mid(strSource, 5, 1)
If Len(strSource) > 5 Then
strResult = strResult & "("
For i = 6 To Len(strSource)
strResult = strResult & Mid(strSource, i, 1) & ","
Next i
strResult = Left(strResult, Len(strResult) - 1) & ")"
End If
strResult = strResult & " "
Else
strResult = strResult & strSource & " "
End If
Next
If strResult = "" Then
ConvertString = ""
Else
ConvertString = Left(strResult, Len(strResult) - 1)
End If
End Function
