Solved

VBA Excel Run-time error 91 object variable or with block variable not set

Posted on 2004-08-31
9
323 Views
Last Modified: 2010-05-02
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:=cf1, After:=[c4], LookIn:=xlValues, _
         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:=cf2, After:=[A4], LookIn:=xlValues, _
         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.
0
Comment
Question by:gfilipe
  • 6
  • 3
9 Comments
 
LVL 35

Expert Comment

by:mvidas
Comment Utility
Hi gfilipe,

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:=cf1, After:=[c4], LookIn:=xlValues, _
         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:=cf1, After:=[c4], LookIn:=xlValues, _
         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:=cf2, After:=[A4], LookIn:=xlValues, _
    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
0
 
LVL 35

Expert Comment

by:mvidas
Comment Utility
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:=cf1, After:=[c4], LookIn:=xlValues, _
    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:=cf2, After:=[A4])
   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
0
 
LVL 35

Expert Comment

by:mvidas
Comment Utility
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.Cells(r, c).Text, After:=[c4], LookIn:=xlValues, _
    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.Cells(r, c).Text, After:=[A4]) Is Nothing Then Cells _
    (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
0
 
LVL 2

Author Comment

by:gfilipe
Comment Utility
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...
0
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
LVL 35

Expert Comment

by:mvidas
Comment Utility
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).Cells
  If rng2.Find(CLL.Text) Is Nothing Then rng1.Parent.Cells(CLL.Row, 30) = CLL.Text Else _
   rng1.Parent.Cells(CLL.Row, 26) = CLL.Text
 Next CLL
 For Each CLL In Intersect(rng2, rng2.Parent.UsedRange).Cells
  If rng1.Find(CLL.Text) Is Nothing Then rng2.Parent.Cells(CLL.Row, 31) = CLL.Text Else _
   rng2.Parent.Cells(CLL.Row, 27) = CLL.Text
 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!
0
 
LVL 2

Author Comment

by:gfilipe
Comment Utility
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.
0
 
LVL 35

Accepted Solution

by:
mvidas earned 290 total points
Comment Utility
OK, its a little bit longer, but still does the trick.  I fixed the status bar thing, and added the column 4 to 10 thing as well.  I wasn't sure if you wanted 4:10 copied for rng2 as well, so I added those lines but commented them out if you dont need them.  Give this a try, and let me know:

Sub WorksheetR(rng1 As Range, rng2 As Range)
 Dim CLL As Range, ctr As Long, tot As Long
 tot = Intersect(rng1, rng1.Parent.UsedRange).Cells.Count + Intersect(rng2, rng2.Parent.UsedRange).Cells.Count
 ctr = 0
 For Each CLL In Intersect(rng1, rng1.Parent.UsedRange).Cells
  ctr = ctr + 1
  If rng2.Find(CLL.Text) Is Nothing Then
   rng1.Parent.Cells(CLL.Row, 37) = CLL.Text
   Range(rng1.Parent.Cells(CLL.Row, 4), rng1.Parent.Cells(CLL.Row, 10)).Copy _
    Destination:=rng1.Parent.Cells(CLL.Row, 39)
  Else
   rng1.Parent.Cells(CLL.Row, 26) = CLL.Text
   Range(rng1.Parent.Cells(CLL.Row, 4), rng1.Parent.Cells(CLL.Row, 10)).Copy _
    Destination:=rng1.Parent.Cells(CLL.Row, 28)
  End If
  Application.StatusBar = "Working " & Format(ctr / tot, "0 %") & "..."
 Next CLL
 For Each CLL In Intersect(rng2, rng2.Parent.UsedRange).Cells
  ctr = ctr + 1
  If rng1.Find(CLL.Text) Is Nothing Then
   rng2.Parent.Cells(CLL.Row, 38) = CLL.Text
'   Range(rng2.Parent.Cells(CLL.Row, 4), rng2.Parent.Cells(CLL.Row, 10)).Copy _
    Destination:=rng2.Parent.Cells(CLL.Row, 39)
  Else
   rng2.Parent.Cells(CLL.Row, 27) = CLL.Text
'   Range(rng2.Parent.Cells(CLL.Row, 4), rng2.Parent.Cells(CLL.Row, 10)).Copy _
    Destination:=rng2.Parent.Cells(CLL.Row, 28)
  End If
  Application.StatusBar = "Working " & Format(ctr / tot, "0 %") & "..."
 Next CLL
 Application.StatusBar = False
End Sub
0
 
LVL 2

Author Comment

by:gfilipe
Comment Utility
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
0
 
LVL 35

Expert Comment

by:mvidas
Comment Utility
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
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now