error 91, Object Variable or With Block not set when calling second range /

[peligroso]

Hi All,

I have an issue when calling a second procedure from within a range find execution. I am getting a run-time error 91, Object Variable or With Block not set.

Basically I am

• looping an array
• using .find to search for the value in a column
• Insert a number of rows after the value if found
• Call procedure, execute another find to using range / with
  • Find another value / range and select
  • Copy from another worksheet a range into the blank rows....
• continue searching

The problem is line 54 which calls the procedure to insert the range after the rows have been inserted. If this is commented out, the search works fine. If the call is made to insertBundleItems procedure, the range is copied and pasted however when execution returns I get the error when execution hits line 56 (first instance). The rng object is nothing at this point. I assume this is loss of the reference to the range however I am at a loss to understand why.

Help really appreciated.


1 sub parseBoxes()
2
3 ' Create search criteria and assign to range.
4 ' Search for boxes and insert rows to allow for box produce.
5
6 Dim vLookupSheet As Worksheet
7 Dim vDataSheet As Worksheet
8 Dim vStartRow As Integer
9 Dim vEndRow As Integer
10 Dim vGroupedItem As Variant
11 Dim vBundleItems As Range
12 Dim vLastRowBundles As Integer
13 Dim vLastRowOrders As Integer
14
15
16 Set vLookupSheet = Worksheets("Lookup")
17 Set vDataSheet = Worksheets("Raw Data")
18
19 With vLookupSheet.Range("box_list")
20 vLastRowBundles = .End(xlDown).Row
21 End With
22
23 With vDataSheet.Range("A:A")
24 vLastRowOrders = .End(xlDown).Row
25 End With
26
27 vBoxArray = vLookupSheet.Range("B6:D" & vLastRowBundles).Value
28
29 For I = LBound(vBoxArray) To UBound(vBoxArray)
30
31 vFullName = vBoxArray(I, 1)
32 vReplaceName = vBoxArray(I, 2)
33 vRowsToInsert = vBoxArray(I, 3)
34 vTestRng = vDataSheet.Range("Q2:Q10000")
35 With vDataSheet.Range("Q:Q")
36 'If you want to find a part of the rng.value then use xlPart
37 'if you use LookIn:=xlValues it will also work with a
38 'formula cell that evaluates to MySearch(I)
39 Set rng = .Find(What:=vFullName, _
40 After:=.Cells(.Cells.Count), _
41 LookIn:=xlValues, _
42 LookAt:=xlWhole, _
43 SearchOrder:=xlByRows, _
44 SearchDirection:=xlNext, _
45 MatchCase:=False)
46
47 If Not rng Is Nothing Then 'Execute if valid range found
48 FirstAddress = rng.Address
49 Do
50 vPasteCol = rng.Column
51 vStartRow = rng.Row + 1
52 vEndRow = vStartRow + vRowsToInsert - 1
53 vDataSheet.Rows(vStartRow & ":" & vEndRow).Insert Shift:=xlDown
54 Call insertBundleItems(vReplaceName, vRowsToInsert, vStartRow)
55 Set rng = .FindNext(rng)
56 Loop While Not rng Is Nothing And rng.Address <> FirstAddress
57 End If
58 End With
59
60 Next I
61
62 End Sub
63
64 Sub insertBundleItems(pBundleName As Variant, pArrayLength As Variant, pPasteRow As Variant)
65
66 'Get Bundle items for bundle name
67
68 Dim vBundleStart As Variant
69 Dim vBundleItems As Variant
70 Dim vBundleEndRange As Variant
71 Dim vPasteRange As String
72
73 With Sheets("Lookup").Range("box_items")
74 Set vBundle = _
75 .Find(What:=pBundleName, _
76 LookIn:=xlValues, _
77 LookAt:=xlWhole, _
78 SearchOrder:=xlByRows, _
79 SearchDirection:=xlNext, _
80 MatchCase:=False)
81 If Not vBundle Is Nothing Then
82 vEndRow = vBundle.Row + (pArrayLength - 1)
83 vBundleColumn = Split(Cells(1, vBundle.Column + 2).Address, "$")(1) 'Convert number to letter
84 vBundleRow = vBundle.Row
85 'vBundleRange = (Left(vBundle.Address, Len(vBundle.Address))) & ":" & "$K$" & vEndRow
86 vBundleRange = (vBundleColumn & vBundleRow & ":" & "K" & vEndRow)
87 Sheets("Lookup").Range(vBundleRange).Copy Sheets("Raw Data").Range("Q" & pPasteRow)
88 End If
89 End With
90
91 End Sub

 

[peligroso]

Reformatted sop its more readable....

01 sub parseBoxes()
02
03   ' Create search criteria and assign to range.
04   ' Search for boxes and insert rows to allow for box produce.
05
06    Dim vLookupSheet As Worksheet
07    Dim vDataSheet As Worksheet
08    Dim vStartRow As Integer
09    Dim vEndRow As Integer
10    Dim vGroupedItem As Variant
11    Dim vBundleItems As Range
12    Dim vLastRowBundles As Integer
13    Dim vLastRowOrders As Integer
14
15
16    Set vLookupSheet = Worksheets("Lookup")
17    Set vDataSheet = Worksheets("Raw Data")
18
19    With vLookupSheet.Range("box_list")
20       vLastRowBundles = .End(xlDown).Row
21    End With
22
23    With vDataSheet.Range("A:A")
24       vLastRowOrders = .End(xlDown).Row
25    End With
26
27    vBoxArray = vLookupSheet.Range("B6:D" & vLastRowBundles).Value
28
29    For I = LBound(vBoxArray) To UBound(vBoxArray)
30
31       vFullName = vBoxArray(I, 1)
32       vReplaceName = vBoxArray(I, 2)
33       vRowsToInsert = vBoxArray(I, 3)
34       vTestRng = vDataSheet.Range("Q2:Q10000")
35       With vDataSheet.Range("Q:Q")
36          'If you want to find a part of the rng.value then use xlPart
37          'if you use LookIn:=xlValues it will also work with a
38          'formula cell that evaluates to MySearch(I)
39          Set rng = .Find(What:=vFullName, _
40            After:=.Cells(.Cells.Count), _
41            LookIn:=xlValues, _
42            LookAt:=xlWhole, _
43            SearchOrder:=xlByRows, _
44            SearchDirection:=xlNext, _
45            MatchCase:=False)
46
47            If Not rng Is Nothing Then 'Execute if valid range found
48                FirstAddress = rng.Address
49                Do
50                         vPasteCol = rng.Column
51                         vStartRow = rng.Row + 1
52                         vEndRow = vStartRow + vRowsToInsert - 1
53                         vDataSheet.Rows(vStartRow & ":" & vEndRow).Insert Shift:=xlDown
54                         Call insertBundleItems(vReplaceName, vRowsToInsert, vStartRow)
55                         Set rng = .FindNext(rng)
56                Loop While Not rng Is Nothing And rng.Address <> FirstAddress
57             End If
58       End With
59
60    Next I
61
62 End Sub
63
64 Sub insertBundleItems(pBundleName As Variant, pArrayLength As Variant, pPasteRow As Variant)
65
66    'Get Bundle items for bundle name
67
68    Dim vBundleStart As Variant
69    Dim vBundleItems As Variant
70    Dim vBundleEndRange As Variant
71    Dim vPasteRange As String
72
73    With Sheets("Lookup").Range("box_items")
74       Set vBundle = _
75       .Find(What:=pBundleName, _
76          LookIn:=xlValues, _
77          LookAt:=xlWhole, _
78          SearchOrder:=xlByRows, _
79          SearchDirection:=xlNext, _
80          MatchCase:=False)
81          If Not vBundle Is Nothing Then
82             vEndRow = vBundle.Row + (pArrayLength - 1)
83             vBundleColumn = Split(Cells(1, vBundle.Column + 2).Address, "$")(1) 'Convert number to letter
84             vBundleRow = vBundle.Row
85             'vBundleRange = (Left(vBundle.Address, Len(vBundle.Address))) & ":" & "$K$" & vEndRow
86             vBundleRange = (vBundleColumn & vBundleRow & ":" & "K" & vEndRow)
87             Sheets("Lookup").Range(vBundleRange).Copy Sheets("Raw Data").Range("Q" & pPasteRow)
88          End If
89      End With
90
91 End Sub

 

[Peter_SSs]

Reformatted sop its more readable....

You need to use code tags. See my signature block below. I have fixed it for you in post 2.

 

[peligroso]

You need to use code tags. See my signature block below. I have fixed it for you in post 2.

Thank you! First post here

 

[jasonb75]

I've tried replicating the section that is causing the error and not had any issues with rng reverting to nothing.
Noting that you appear to have declared all of your variables with the exception of rng and thinking beyond what we can see, is rng declared elsewhere as a public variable and perhaps being cleared by another procedure that is being triggered? You haven't disabled events in your code so a worksheet change event or similar could be firing and setting rng to nothing.

 

[dmt32]

I get the error when execution hits line 56 (first instance). The rng object is nothing at this point. I assume this is loss of the reference to the range however I am at a loss to understand why.

Hi,
try changing these lines in your code

55 Set Rng = .FindNext(Rng)
56  Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress

to this

55 Set Rng = .FindNext(Rng)
56 If Rng Is Nothing Then Exit Do
57  Loop While Rng.Address <> FirstAddress

and see if this helps you

Dave