C
ChipButtyMan
Hi,
have a workbook with many sheets with many subs.
When I debug (F8 step through) the first code below, it does its job
just fine but then runs through a function in module1 (the 2nd piece
of code below)
Nothing terrible happens but of course this shouldn't happen. The code
in the function is nothing to do with the first worksheet.
What did I do wrong;
Sub test()
Dim a, i As Long, b(), n As Long, x
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)
If (Not IsEmpty(a(i, 1))) * (Not .exists(a(i, 1))) Then .Add a(i,
1), Nothing
Next
ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
If Not IsEmpty(a(i, 2)) Then
If Not .exists(a(i, 2)) Then
n = n + 1: b(n, 1) = a(i, 2)
Else
.Remove a(i, 2)
End If
End If
Next
x = .keys
End With
With Range("d1")
.CurrentRegion.ClearContents
.Resize(, 2).Value = [{"Not in A", "Not in B"}]
With .Offset(1)
If n > 0 Then .Resize(n).Value = b
End With
On Error Resume Next
.Offset(1, 1).Resize(n).Value = Application.Transpose(x)
End With
End Sub
'WHEN IT'S DONE IT JUMPS TO THIS FUNCTION IN Module1
Function FuzzyMatch(rng1 As Range, ParamArray a() As Variant) As
Variant
Dim myPtn As String, e As Variant, r As Range
Dim flg As Boolean, result
Application.Volatile
For Each e In a
For Each r In e
If r.Value <> "" Then
With CreateObject("VBScript.RegExp")
.Pattern = "(.)"
.Global = True
myPtn = .Replace(Trim(r.Value), "0*$1")
.Pattern = "(" & Mid$(myPtn, 3) & ")"
If .test(Trim(rng1.Value)) Then
flg = True
Exit For
End If
End With
End If
Next
If flg Then Exit For
Next
If flg Then
Select Case r.Interior.ColorIndex
Case 3: result = "Available for Road Test"
Case 4: result = "Ready to ship"
Case 6: result = "Available for body fit"
Case 45: result = "White Sheet"
Case 38: result = "Finals paint"
Case 39: result = "Available for BZ"
Case 41: result = "Outstanding work"
Case Else: result = "No result"
End Select
FuzzyMatch = result
Else
FuzzyMatch = CVErr(xlErrNA)
End If
End Function
Thank you for your time and expertise
have a workbook with many sheets with many subs.
When I debug (F8 step through) the first code below, it does its job
just fine but then runs through a function in module1 (the 2nd piece
of code below)
Nothing terrible happens but of course this shouldn't happen. The code
in the function is nothing to do with the first worksheet.
What did I do wrong;
Sub test()
Dim a, i As Long, b(), n As Long, x
With CreateObject("Scripting.Dictionary")
.CompareMode = vbTextCompare
For i = 1 To UBound(a, 1)
If (Not IsEmpty(a(i, 1))) * (Not .exists(a(i, 1))) Then .Add a(i,
1), Nothing
Next
ReDim b(1 To UBound(a, 1), 1 To 1)
For i = 1 To UBound(a, 1)
If Not IsEmpty(a(i, 2)) Then
If Not .exists(a(i, 2)) Then
n = n + 1: b(n, 1) = a(i, 2)
Else
.Remove a(i, 2)
End If
End If
Next
x = .keys
End With
With Range("d1")
.CurrentRegion.ClearContents
.Resize(, 2).Value = [{"Not in A", "Not in B"}]
With .Offset(1)
If n > 0 Then .Resize(n).Value = b
End With
On Error Resume Next
.Offset(1, 1).Resize(n).Value = Application.Transpose(x)
End With
End Sub
'WHEN IT'S DONE IT JUMPS TO THIS FUNCTION IN Module1
Function FuzzyMatch(rng1 As Range, ParamArray a() As Variant) As
Variant
Dim myPtn As String, e As Variant, r As Range
Dim flg As Boolean, result
Application.Volatile
For Each e In a
For Each r In e
If r.Value <> "" Then
With CreateObject("VBScript.RegExp")
.Pattern = "(.)"
.Global = True
myPtn = .Replace(Trim(r.Value), "0*$1")
.Pattern = "(" & Mid$(myPtn, 3) & ")"
If .test(Trim(rng1.Value)) Then
flg = True
Exit For
End If
End With
End If
Next
If flg Then Exit For
Next
If flg Then
Select Case r.Interior.ColorIndex
Case 3: result = "Available for Road Test"
Case 4: result = "Ready to ship"
Case 6: result = "Available for body fit"
Case 45: result = "White Sheet"
Case 38: result = "Finals paint"
Case 39: result = "Available for BZ"
Case 41: result = "Outstanding work"
Case Else: result = "No result"
End Select
FuzzyMatch = result
Else
FuzzyMatch = CVErr(xlErrNA)
End If
End Function
Thank you for your time and expertise