VBA Excel Run-time error 91 object variable or with block variable not set
Hello everyone...
I've been trying to surpress this problem for some time now but still no luck.
Everything works ok except when the searched cf1 or cf2 string isn't found, then I get this run-time error 91. The error is already detected (By the way it stop's on the Set SearchB or SearchS) what I need is a way to turn around it. Here is the code:
Option Explicit
Sub WorksheetR(rng1 As Range, rng2 As Range)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Integer, maxC As Integer, cf1 As String, cf2 As String
DiffCount As Long
Dim y As Integer
Dim j As Integer
Dim i As Integer
Dim Found As Boolean
Dim SearchS
Dim SearchB
Dim Encontrado As Variant
Dim NaoEncontrado As Variant
Dim Encontrado1 As Variant
Dim NaoEncontrado1 As Variant
i = i + 1
j = j + 1
y = y + 1
Application.DisplayAlerts = True
With rng1
lr1 = .Rows.Count
lc1 = .Columns.Count
End With
With rng2
lr2 = .Rows.Count
lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
DiffCount = 0
For c = 1 To maxC
Application.StatusBar = "Working " & _
Format(r / maxR, "0 %") & "..."
For r = 1 To maxR
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = rng1.Cells(r, c).FormulaLocal
cf2 = rng2.Cells(r, c).FormulaLocal
On Error GoTo 0
Set SearchB = Columns("C:C").Find(What:=
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Columns
If SearchB <> cf2 Or SearchB = "" Then
Found = False
ElseIf SearchB = cf1 Then
Found = True
End If
If Found = False Then
GoTo NaoEncontrado
End If
If Found = True Then
GoTo Encontrado
End If
If Found = True Then
Encontrado: rng2.Cells(r, c).Copy
Cells(5 + i, 26).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ElseIf Found = False Then
NaoEncontrado:
rng2.Cells(r, c).Copy
Cells(5 + y, 30).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Set SearchS = Columns("A:A").Find(What:=
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Columns
If SearchS <> cf2 Or SearchS = "" Then
Found = False
End If
If Found = False Then
GoTo NaoEncontrado1
End If
If SearchS = cf2 Then
Found = True
End If
If Found = True Then
GoTo Encontrado1
End If
If Found = True Then
Encontrado1:
rng1.Cells(r, c).Copy
Cells(5 + i, 27).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ElseIf Found = False Then
NaoEncontrado1:
rng1.Cells(r, c).Copy
Cells(5 + j, 31).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next r
Next c
Application.CutCopyMode = False
End Sub
- > rng1 and rng2 (A and C columns) activated by a button that starts the process...
Ok, that's about it... what I need to do is copy between (column A and C) all equal values to a range on that sheet then copy the values that exist only on column A and then again copy the values that only exist on column C.
This code works ok exept for that "Small" issue ... Thanks in advance.
I've been trying to surpress this problem for some time now but still no luck.
Everything works ok except when the searched cf1 or cf2 string isn't found, then I get this run-time error 91. The error is already detected (By the way it stop's on the Set SearchB or SearchS) what I need is a way to turn around it. Here is the code:
Option Explicit
Sub WorksheetR(rng1 As Range, rng2 As Range)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Integer, maxC As Integer, cf1 As String, cf2 As String
DiffCount As Long
Dim y As Integer
Dim j As Integer
Dim i As Integer
Dim Found As Boolean
Dim SearchS
Dim SearchB
Dim Encontrado As Variant
Dim NaoEncontrado As Variant
Dim Encontrado1 As Variant
Dim NaoEncontrado1 As Variant
i = i + 1
j = j + 1
y = y + 1
Application.DisplayAlerts = True
With rng1
lr1 = .Rows.Count
lc1 = .Columns.Count
End With
With rng2
lr2 = .Rows.Count
lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
DiffCount = 0
For c = 1 To maxC
Application.StatusBar = "Working " & _
Format(r / maxR, "0 %") & "..."
For r = 1 To maxR
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = rng1.Cells(r, c).FormulaLocal
cf2 = rng2.Cells(r, c).FormulaLocal
On Error GoTo 0
Set SearchB = Columns("C:C").Find(What:=
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Columns
If SearchB <> cf2 Or SearchB = "" Then
Found = False
ElseIf SearchB = cf1 Then
Found = True
End If
If Found = False Then
GoTo NaoEncontrado
End If
If Found = True Then
GoTo Encontrado
End If
If Found = True Then
Encontrado: rng2.Cells(r, c).Copy
Cells(5 + i, 26).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ElseIf Found = False Then
NaoEncontrado:
rng2.Cells(r, c).Copy
Cells(5 + y, 30).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Set SearchS = Columns("A:A").Find(What:=
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Columns
If SearchS <> cf2 Or SearchS = "" Then
Found = False
End If
If Found = False Then
GoTo NaoEncontrado1
End If
If SearchS = cf2 Then
Found = True
End If
If Found = True Then
GoTo Encontrado1
End If
If Found = True Then
Encontrado1:
rng1.Cells(r, c).Copy
Cells(5 + i, 27).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
ElseIf Found = False Then
NaoEncontrado1:
rng1.Cells(r, c).Copy
Cells(5 + j, 31).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Next r
Next c
Application.CutCopyMode = False
End Sub
- > rng1 and rng2 (A and C columns) activated by a button that starts the process...
Ok, that's about it... what I need to do is copy between (column A and C) all equal values to a range on that sheet then copy the values that exist only on column A and then again copy the values that only exist on column C.
This code works ok exept for that "Small" issue ... Thanks in advance.
Hi,
Not being one to enjoy long code, I've condensed it a bit more:
Sub WorksheetR(rng1 As Range, rng2 As Range)
Dim r As Long, c As Integer, lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Integer, maxC As Integer, cf1 As String, cf2 As String
Dim DiffCount As Long, y As Integer, j As Integer, i As Integer, Found As Boolean
Dim SearchS As Range, SearchB As Range
i = i + 1 'not being incremented
j = j + 1 'not being incremented
y = y + 1 'not being incremented
lr1 = rng1.Rows.Count
lc1 = rng1.Columns.Count
lr2 = rng2.Rows.Count
lc2 = rng2.Columns.Count
maxR = lr1
maxC = lc1
DiffCount = 0
For c = 1 To maxC
For r = 1 To maxR
Application.StatusBar = "Working " & Format(r / maxR, "0 %") & "..."
cf1 = rng1.Cells(r, c).Text
cf2 = rng2.Cells(r, c).Text
Set SearchB = Columns("C:C").Find(What:=
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If SearchB Is Nothing Then
Cells(5 + y, 30) = rng2.Cells(r, c).Value
Else
Cells(5 + i, 26) = rng2.Cells(r, c).Value
End If
Set SearchS = Columns("A:A").Find(What:=
If SearchS Is Nothing Then
Cells(5 + j, 31) = rng1.Cells(r, c).Value
Else
Cells(5 + i, 27) = rng1.Cells(r, c).Value
End If
Next r
Next c
End Sub
Not being one to enjoy long code, I've condensed it a bit more:
Sub WorksheetR(rng1 As Range, rng2 As Range)
Dim r As Long, c As Integer, lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Integer, maxC As Integer, cf1 As String, cf2 As String
Dim DiffCount As Long, y As Integer, j As Integer, i As Integer, Found As Boolean
Dim SearchS As Range, SearchB As Range
i = i + 1 'not being incremented
j = j + 1 'not being incremented
y = y + 1 'not being incremented
lr1 = rng1.Rows.Count
lc1 = rng1.Columns.Count
lr2 = rng2.Rows.Count
lc2 = rng2.Columns.Count
maxR = lr1
maxC = lc1
DiffCount = 0
For c = 1 To maxC
For r = 1 To maxR
Application.StatusBar = "Working " & Format(r / maxR, "0 %") & "..."
cf1 = rng1.Cells(r, c).Text
cf2 = rng2.Cells(r, c).Text
Set SearchB = Columns("C:C").Find(What:=
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If SearchB Is Nothing Then
Cells(5 + y, 30) = rng2.Cells(r, c).Value
Else
Cells(5 + i, 26) = rng2.Cells(r, c).Value
End If
Set SearchS = Columns("A:A").Find(What:=
If SearchS Is Nothing Then
Cells(5 + j, 31) = rng1.Cells(r, c).Value
Else
Cells(5 + i, 27) = rng1.Cells(r, c).Value
End If
Next r
Next c
End Sub
Thinking more, you may want to add
Application.StatusBar = False
After the Next c statement to reset the status bar.
Also, as I said, I don't like long code, and I shortened it a bit more (could be shorter but I left i,y,j in there as they look like they're necessary, but I took out MaxR MaxC lr1 lr2 lc1 lc2 as they didn't really do a whole lot, and looked like they were being used in previous versions of the code). Sorry to keep posting like this, this is my last revision:
Sub WorksheetR(rng1 As Range, rng2 As Range)
Dim r As Long, c As Integer, cf1 As String, cf2 As String
Dim y As Integer, j As Integer, i As Integer
i = i + 1 'not being incremented
j = j + 1 'not being incremented
y = y + 1 'not being incremented
For c = 1 To rng1.Columns.Count
For r = 1 To rng1.Rows.Count
Application.StatusBar = "Working " & Format(r / rng1.Rows.Count, "0 %") & "..."
If Columns(3).Find(What:=rng1
LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False) Is Nothing Then Cells(5 _
+ y, 30) = rng2.Cells(r, c).Value Else Cells(5 + i, 26) = rng2.Cells(r, c).Value
If Columns(1).Find(What:=rng2
(5 + j, 31) = rng1.Cells(r, c).Value Else Cells(5 + i, 27) = rng1.Cells(r, c).Value
Next r
Next c
Application.StatusBar = False
End Sub
Matt
Application.StatusBar = False
After the Next c statement to reset the status bar.
Also, as I said, I don't like long code, and I shortened it a bit more (could be shorter but I left i,y,j in there as they look like they're necessary, but I took out MaxR MaxC lr1 lr2 lc1 lc2 as they didn't really do a whole lot, and looked like they were being used in previous versions of the code). Sorry to keep posting like this, this is my last revision:
Sub WorksheetR(rng1 As Range, rng2 As Range)
Dim r As Long, c As Integer, cf1 As String, cf2 As String
Dim y As Integer, j As Integer, i As Integer
i = i + 1 'not being incremented
j = j + 1 'not being incremented
y = y + 1 'not being incremented
For c = 1 To rng1.Columns.Count
For r = 1 To rng1.Rows.Count
Application.StatusBar = "Working " & Format(r / rng1.Rows.Count, "0 %") & "..."
If Columns(3).Find(What:=rng1
LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False) Is Nothing Then Cells(5 _
+ y, 30) = rng2.Cells(r, c).Value Else Cells(5 + i, 26) = rng2.Cells(r, c).Value
If Columns(1).Find(What:=rng2
(5 + j, 31) = rng1.Cells(r, c).Value Else Cells(5 + i, 27) = rng1.Cells(r, c).Value
Next r
Next c
Application.StatusBar = False
End Sub
Matt
ASKER
Hi Matt,
Thanks for your postings... and by the way very nice strait forward coding...:)
But that was not exactly what I need to do, I think I didin't express myself correctly, so I'll try it again:
Basically I need to do a comparison between the two ranges (Column A and C). With the following specific criteria:
Column 26 - Contains Values from Column A that exists on Column C
Column 27 - Contains Values from Column C that exists on Column A
Column 30 - Contains Values from Column A that do not exists on Column C
Column 31 - Contains Values from Column C that do not exists on Column A
The values should increment on row for each column.
By the way you were right about having previous version of code (big mess I made... :) and you were also right about a major speed increase taking out the .columns (in the SearchX) and making the test if using the nothing first...
Thanks anyway...
Thanks for your postings... and by the way very nice strait forward coding...:)
But that was not exactly what I need to do, I think I didin't express myself correctly, so I'll try it again:
Basically I need to do a comparison between the two ranges (Column A and C). With the following specific criteria:
Column 26 - Contains Values from Column A that exists on Column C
Column 27 - Contains Values from Column C that exists on Column A
Column 30 - Contains Values from Column A that do not exists on Column C
Column 31 - Contains Values from Column C that do not exists on Column A
The values should increment on row for each column.
By the way you were right about having previous version of code (big mess I made... :) and you were also right about a major speed increase taking out the .columns (in the SearchX) and making the test if using the nothing first...
Thanks anyway...
That makes sense, try the following:
Sub WorksheetR(rng1 As Range, rng2 As Range)
Dim CLL As Range
For Each CLL In Intersect(rng1, rng1.Parent.UsedRange).Cel
If rng2.Find(CLL.Text) Is Nothing Then rng1.Parent.Cells(CLL.Row,
rng1.Parent.Cells(CLL.Row,
Next CLL
For Each CLL In Intersect(rng2, rng2.Parent.UsedRange).Cel
If rng1.Find(CLL.Text) Is Nothing Then rng2.Parent.Cells(CLL.Row,
rng2.Parent.Cells(CLL.Row,
Next CLL
End Sub
If the value in rng1 is in rng2, it puts that value in column 26 on the same row. If not in rng2, it puts it in 30
Similarly for rng2 being in rng2, but with columns 27 and 31 instead
Let me know if it's not what you want!
Sub WorksheetR(rng1 As Range, rng2 As Range)
Dim CLL As Range
For Each CLL In Intersect(rng1, rng1.Parent.UsedRange).Cel
If rng2.Find(CLL.Text) Is Nothing Then rng1.Parent.Cells(CLL.Row,
rng1.Parent.Cells(CLL.Row,
Next CLL
For Each CLL In Intersect(rng2, rng2.Parent.UsedRange).Cel
If rng1.Find(CLL.Text) Is Nothing Then rng2.Parent.Cells(CLL.Row,
rng2.Parent.Cells(CLL.Row,
Next CLL
End Sub
If the value in rng1 is in rng2, it puts that value in column 26 on the same row. If not in rng2, it puts it in 30
Similarly for rng2 being in rng2, but with columns 27 and 31 instead
Let me know if it's not what you want!
ASKER
Hi,
Ok that did the trick, perfect, but with a small issue in the end, need to press esc (abort the code) otherwise it won't give the command back to the user.
-> I was almost posting when realised this isn't constant, it doesnt happens everytime...
Another thing regarding the Application.StatusBar, have you got any idea how can I make the count now?
And finally there is something I was able to make (I didin't mention it because it was easy to grab the ranges and make a copy/paste), and now I don't really know how to do it,
When values exist on Column C it should also copy from Column 4 (Included) to 10. Trying to explain it better:
if cll.text in rng2 exists then should copy from column 4 to 10 to either (depending to were it goes) Column 28 or Column 39.
Yes you are wondering how if values are going to overwrite the previous written values, changing the inicial paste place from:
Column 30 to 37
Column 31 to 38
In small words were rng2 exists should copy until column -7.
If you have any idea using your code how to turn around it also, please let me now....
Thanks again.
Ok that did the trick, perfect, but with a small issue in the end, need to press esc (abort the code) otherwise it won't give the command back to the user.
-> I was almost posting when realised this isn't constant, it doesnt happens everytime...
Another thing regarding the Application.StatusBar, have you got any idea how can I make the count now?
And finally there is something I was able to make (I didin't mention it because it was easy to grab the ranges and make a copy/paste), and now I don't really know how to do it,
When values exist on Column C it should also copy from Column 4 (Included) to 10. Trying to explain it better:
if cll.text in rng2 exists then should copy from column 4 to 10 to either (depending to were it goes) Column 28 or Column 39.
Yes you are wondering how if values are going to overwrite the previous written values, changing the inicial paste place from:
Column 30 to 37
Column 31 to 38
In small words were rng2 exists should copy until column -7.
If you have any idea using your code how to turn around it also, please let me now....
Thanks again.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hi,
Matt that was the exact solution I was looking for... yes I was looking also for rng2 as well (Thanks also for that easy tip).
You really now how to handle VBA, I can understand what is done but I would never be able to reach this kind of solution by myself. So keep up the very good work.
See you around,
regards
Gfilipe
Matt that was the exact solution I was looking for... yes I was looking also for rng2 as well (Thanks also for that easy tip).
You really now how to handle VBA, I can understand what is done but I would never be able to reach this kind of solution by myself. So keep up the very good work.
See you around,
regards
Gfilipe
Thanks! A lot of that could have even been abbreviated (all the .Parent calls) but I wasn't sure if you were calling it from an activesheet or not, so the extra steps seem worth it. If you have any questions about how part of it works or anything, please feel free to ask and I'll explain the best I can. Let me know if anything else comes up with it too, or needs any adjusting.
Matt
Matt
A couple small changes can get your code running the way you want, although from what it seems (without looking at your source data) it seems that what you want to do can be done a bit faster. The main thing is in the Set SearchX statements, first take out the .Columns at the end of it. Then in the if/then statements, first test if SearchX is Nothing before testing otherwise:
Set SearchB = Columns("C:C").Find(What:=
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If SearchB Is Nothing Then
Found = False
ElseIf SearchB <> cf2 Then '*** are you meaning to compare it to cf1 ?
Found = False
ElseIf SearchB = cf1 Then
Found = True
End If
Do the same for SearchS. A bit of condensing your code will bring it to:
Sub WorksheetR(rng1 As Range, rng2 As Range)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Integer, maxC As Integer, cf1 As String, cf2 As String
Dim DiffCount As Long
Dim y As Integer
Dim j As Integer
Dim i As Integer
Dim Found As Boolean
Dim SearchS
Dim SearchB
Dim Encontrado As Variant
Dim NaoEncontrado As Variant
Dim Encontrado1 As Variant
Dim NaoEncontrado1 As Variant
i = i + 1
j = j + 1
y = y + 1
Application.DisplayAlerts = True
With rng1
lr1 = .Rows.Count
lc1 = .Columns.Count
End With
With rng2
lr2 = .Rows.Count
lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
DiffCount = 0
For c = 1 To maxC
Application.StatusBar = "Working " & Format(r / maxR, "0 %") & "..."
For r = 1 To maxR
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = rng1.Cells(r, c).FormulaLocal
cf2 = rng2.Cells(r, c).FormulaLocal
On Error GoTo 0
Set SearchB = Columns("C:C").Find(What:=
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If SearchB Is Nothing Then Found = False Else Found = True
' If Found = False Then GoTo NaoEncontrado
' If Found = True Then GoTo Encontrado
If Found = True Then
'Encontrado:
Cells(5 + i, 26) = rng2.Cells(r, c).Value
Else
'NaoEncontrado:
Cells(5 + y, 30) = rng2.Cells(r, c).Value
End If
Set SearchS = Columns("A:A").Find(What:=
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If SearchS Is Nothing Then Found = False Else Found = True
' If Found = False Then GoTo NaoEncontrado1
' If Found = True Then GoTo Encontrado1
If Found = True Then
'Encontrado1:
Cells(5 + i, 27) = rng1.Cells(r, c).Value
Else
'NaoEncontrado1:
Cells(5 + j, 31) = rng1.Cells(r, c).Value
End If
Next r
Next c
Application.CutCopyMode = False
End Sub
The only other thing I'm curious about this is you're not incrementing i and j except at the beginning, so they're always going to be placed into row 6. Just a thought.
Matt