FInd Problems

[paddysheeran]

Hi All. I'm having problems with the following. My procedure is desgined to look for a value in one sheet, once it finds the value it copies all the cells underneath it and then pastes these cells into a different workbook. The procedure works fine until the last value is searched (Premium) - at this point:

Rows("2:2").Find(What:="PREMIUM", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select

I get the error message:

Run-time error '91':
Object variable or With block variable not set

There is no data for Premium so that may have something to do with it but there is also no data for Priority 1 and that part of the procedure works fine.... help!!!


Sub Find()
'SVD Assigned
Rows("2:2").Select
On Error Resume Next
With Resolver_Open
Rows("2:2").Find(What:="SVD Assigned", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Activate
Range("B6").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False
End With
'P1
Rows("2:2").Select
On Error Resume Next
With Resolver_Open
On Error GoTo No_P1
Rows("2:2").Find(What:="PRIORITY 1", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Activate
Range("C6").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False

No_P1:
End With
'P2
Rows("2:2").Select
On Error Resume Next
With Resolver_Open
On Error GoTo No_P2
Rows("2:2").Find(What:="PRIORITY 2", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Activate
Range("D6").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False
No_P2:
End With
'P3
Rows("2:2").Select
On Error Resume Next
With Resolver_Open
On Error GoTo No_P3
Rows("2:2").Find(What:="PRIORITY 3", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Activate
Range("E6").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False
No_P3:
End With
'P4
Rows("2:2").Select
On Error Resume Next
With Resolver_Open
On Error GoTo No_P4
Rows("2:2").Find(What:="PRIORITY 4", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Activate
Range("F6").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False
No_P4:
End With
'UDP1
Rows("2:2").Select
On Error Resume Next
With Resolver_Open
On Error GoTo No_UDP1
Rows("2:2").Find(What:="UDP1", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Activate
Range("G6").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False
No_UDP1:
End With
'UDP2
Rows("2:2").Select
On Error Resume Next
With Resolver_Open
On Error GoTo No_UDP2
Rows("2:2").Find(What:="UDP2", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Activate
Range("H6").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False
No_UDP2:
End With

'P5
Rows("2:2").Select
On Error Resume Next
With Resolver_Open
On Error GoTo No_P5
Rows("2:2").Find(What:="PRIORITY 5", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Activate
Range("J6").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False
No_P5:
End With
'Premium
Rows("2:2").Select
On Error Resume Next
With Resolver_Open
On Error GoTo No_PREMIUM
Rows("2:2").Find(What:="PREMIUM", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Activate
Range("I6").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False
No_PREMIUM:
End With
Range("A1").Select
End Sub

[mdmackillop]

To avoid errors if nothing is found, use this methodology. It also avoids unneccesary Selecting and Activation


Sub Find()
Dim c As Range
'SVD Assigned
With Resolver_Open
Set c = Rows("2:2").Find(What:="SVD Assigned", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then Set c = c.Offset(1)
Range(c, c.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Range("B6").PasteSpecial Format:=3, _
Link:=1, DisplayAsIcon:=False, IconFileName:=False
End With

[paddysheeran]

I'm now getting the error message:

Compile error:

End With without With

[mdmackillop]

Can you post your revised code?

[paddysheeran]

Sub Find()

Dim SVD As Range
'SVD Assigned
With Resolver_Open
Set SVD = Rows("2:2").Find(What:="SVD Assigned", After:=ActiveCell, LookIn:= _
xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not SVD Is Nothing Then
Set SVD = SVD.Offset(1)
Range(SVD, SVD.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Range("B6").PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
End With
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False
End Sub

[mdmackillop]

My "If" was all on one line. When you expanded it you needed to add an End If. By using a code indenter, this is easily checked visually, as in your formatted code above.

If Not SVD Is Nothing Then
Set SVD = SVD.Offset(1)
Range(SVD, SVD.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Range("B6").PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
End If

[paddysheeran]

Hi there, its stil lnot working. I've attached both files. Find original works until thew code gets to premium. I haven't been able to make your amendments work....

[paddysheeran]

other file.

[mdmackillop]

To get it working

'Premium
Rows("2:2").Select
On Error Resume Next
With Resolver_Open
Dim c As Range
On Error GoTo No_PREMIUM
Set c = Rows("2:2").Find(What:="PREMIUM", After:=ActiveCell, LookIn:= _
xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
c.Select
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
Windows("CEC Weekly Performance Report -Template.xls").Activate
Range("I6").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Windows("CEC_Calculations.xls").Activate
Application.CutCopyMode = False
End If
No_PREMIUM:
End With

[mdmackillop]

An alternative method

Option Explicit
Sub CopyStuff()
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim Rng As Range, cel As Range
Dim c As Range
Dim tgt As Range
Set wsSource = Workbooks("CEC_Calculations.xls").Sheets("Resolver_Open")
Set wsTarget = Workbooks("CEC Weekly Performance Report -Template.xls").Sheets("Resolver - Priority (Open)")
Set Rng = wsTarget.Range("C5").Resize(, 8)
For Each cel In Rng
Select Case cel
Case "P5 (Chargable)"
Set c = wsSource.Rows(2).Find("PRIORITY 5")
If Not c Is Nothing Then
Range(c.Offset(1), c.Offset(1).End(xlDown)).Copy
wsTarget.Rows(5).Find(cel).Offset(1).PasteSpecial xlValues
End If
Case Else
Set c = wsSource.Rows(2).Find(cel)
If Not c Is Nothing Then
Range(c.Offset(1), c.Offset(1).End(xlDown)).Copy
Set tgt = wsTarget.Rows(5).Find(cel).Offset(1)
tgt.PasteSpecial xlValues
End If
End Select
Next
End Sub

[paddysheeran]

Works good now - thanks for your help.

[mdmackillop]

BTW
With regard to this part of your code

With Resolver_Open
Set SVD = Rows("2:2").Find(What:="SVD Assigned", After:=ActiveCell, LookIn:= _
xlFormulas, lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)


Resolver_Open is nothing, because it has not been set to any value
Once set, eg to a sheet, you need to link it to the cell/range with a Dot operator

With Resolver_Open
.Cells(1,1) = 3
End with
If you don't do this Cells(1,1) will refer to the Active Sheet.