I inherited a VBA project. The workbook has a macro that is used to suggest vendor addresses in a userform based on a partial text string. Once an operator chooses an address they click on "Next" Button, which moves down to the next cell with the partial text string (NEL for Nelco). This macro worked well until the company upgraded to Windows 10 and Excel 2016 (from Windows 7 and Excel 2010). Now the macro crashes and I get Error 380. The code is below. The code where the macro crashes is in red. Any help would be appreciated.
TIA
Willy
TIA
Willy
Rich (BB code):
Sub Address_Helper()
'Prevents user from seeing workbook open
Application.ScreenUpdating = False
Dim WSO As Worksheet
Dim myWb As Excel.Workbook
Dim xlw As Excel.Workbook
Dim FileName As String
Set myWb = ThisWorkbook
'Import the following workbook containing formatted correct addresses
FileName = "S:\quality\Public\~First Articles\~Material Certificates of Compliance\Material_Vendor_Addresses_For_Search.xlsx"
'Try to open addresses workbook
Set xlw = Workbooks.Add(FileName)
Dim TableRange As Range
If IsWorkBookOpen(FileName) Then
xlw.Close
End If
'Specify column in the xlw to find addresses in
Set TableRange = xlw.Sheets("Supplier Addresses").Range("A:A")
Dim Vend1 As String
Dim Vend2 As String
Dim Vend3 As String
Dim VendorFromForm As String
Dim J As Integer
'Get number of lines to loop through for addresses
J = 0
While Not IsEmpty(myWb.Sheets("Form 2").Cells(5 + J, 6)) And Not myWb.Sheets("Form 2").Cells(5 + J, 6).MergeCells
J = J + 1
Debug.Print J
Wend
'Create Array containing 3 most likely addresses for a given supplier address.
ReDim VendorAddress(J, 3)
Dim I As Integer
I = 0
While I < J
'Get current typed addressed
VendorFromForm = myWb.Sheets("Form 2").Cells(5 + I, 4).Value
'Create the relevant number of pages in userform
UserForm2.TabStrip1.Tabs.Add
'If text there, go ahead and try to guess a vendor
If Not Trim(VendorFromForm) = "" Then
'Use functions from Fuzzy_Lookup module to help find close text
Vend1 = CStr(FuzzyVLookup(CStr(VendorFromForm), TableRange, 1, , 1))
Vend2 = CStr(FuzzyVLookup(CStr(VendorFromForm), TableRange, 1, , 2))
Vend3 = CStr(FuzzyVLookup(CStr(VendorFromForm), TableRange, 1, , 3))
'FuzzyVLookup returns Error when it can't find text close to what is typed, so return blank instead
If InStr(Vend1, "Error") = 0 Then
VendorAddress(I, 0) = Vend1
Else
VendorAddress(I, 0) = ""
Debug.Print "Went"
End If
If InStr(Vend2, "Error") = 0 Then
VendorAddress(I, 1) = Vend2
Else
VendorAddress(I, 1) = ""
Debug.Print "Went"
End If
If InStr(Vend3, "Error") = 0 Then
VendorAddress(I, 2) = Vend3
Else
VendorAddress(I, 2) = ""
Debug.Print "Went"
End If
Else
'Return blank if no address
VendorAddress(I, 0) = ""
VendorAddress(I, 1) = ""
VendorAddress(I, 2) = ""
End If
'Give option to go back to original. Goes away upon exit from userform
VendorAddress(I, 3) = CStr(VendorFromForm)
I = I + 1
Wend
'Close addresses workbook
xlw.Close
'Gives time for code to catch up
DoEvents
Dim Q As Integer
'Q determines if an address has text or not when finding first suggestion for userform
Q = 0
'Initially assume it will be first address in workbook
Dim StarterPageTempValue As Integer
Dim RowNumb As Integer
If Not Application.Intersect(ActiveCell, Range("A5:F" + CStr(5 + J))) Is Nothing Then
RowNumb = ActiveCell.Row
StarterPageTempValue = RowNumb - 5
myWb.Sheets("Form 2").Cells(RowNumb, 1).Select
Application.GoTo ActiveCell, True
While Q = 0
If VendorAddress(StarterPageTempValue, 0) = "" And VendorAddress(StarterPageTempValue, 1) = "" And VendorAddress(StarterPageTempValue, 2) = "" And StarterPageTempValue = (UserForm2.TabStrip1.Tabs.Count - 1) Then
'No vendor suggestions and is last line of address, tell user
MsgBox "Sorry, could not find any material certificate address suggestions starting from the selected cell"
Q = 1
'
ElseIf VendorAddress(StarterPageTempValue, 0) = "" And VendorAddress(StarterPageTempValue, 1) = "" And VendorAddress(StarterPageTempValue, 2) = "" Then
'No vendor suggestions, but could possibly find more
StarterPageTempValue = StarterPageTempValue + 1
Else
'Found a suggestion to give, add data to the userform after clearing previous data
UserForm2.ListBox1.Clear
UserForm2.TabStrip1.Value = StarterPageTempValue 'This is where the macro crashes
'Add addresses to listbox
If Not VendorAddress(StarterPageTempValue, 0) = "" Then
UserForm2.ListBox1.AddItem (VendorAddress(StarterPageTempValue, 0))
End If
If Not VendorAddress(StarterPageTempValue, 1) = "" Then
UserForm2.ListBox1.AddItem (VendorAddress(StarterPageTempValue, 1))
End If
If Not VendorAddress(StarterPageTempValue, 2) = "" Then
UserForm2.ListBox1.AddItem (VendorAddress(StarterPageTempValue, 2))
End If
UserForm2.ListBox1.AddItem (VendorAddress(StarterPageTempValue, 3))
Q = 1
'Highlight cell that would be edited
myWb.Sheets("Form 2").Cells(5 + StarterPageTempValue, 4).Interior.ColorIndex = 3
J = 1
End If
Wend
Else
MsgBox "Sorry, could not find any material certificate address suggestions starting from the selected cell"
End If
'Set them on first page, no need for back button
UserForm2.TabStrip1.Value = StarterPageTempValue
UserForm2.CommandButton2.Enabled = False
'Show changes and open form
Application.ScreenUpdating = True
Load UserForm2
UserForm2.Show
End Sub
Last edited by a moderator:
