Object variable or with Block variable not set

[Howard]

This was working for me, and I must have change something to get the variable not set error.

Thanks.
Howard


Option Explicit

Sub FindNewPN()

Dim rngFndPrd As Range
Dim c As Range
Dim ws1Part_Num As Range
Dim ws2From_Item As Range

Set ws1Part_Num = Sheets("Sheet1").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
Set ws2From_Item = Sheets("Sheet2").Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)

Application.ScreenUpdating = False
For Each c In ws1Part_Num

Set rngFndPrd = ws2From_Item.Find(c, LookIn:=xlValues, lookat:=xlWhole)
rngFndPrd.Offset(0, 5).Copy

Sheets("Sheet1").Range("F100").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteAll, Transpose:=False

Application.ScreenUpdating = True

Next
End Sub

 

[Claus Busch]

Hi Howard,

Am Wed, 2 Oct 2013 23:28:45 -0700 (PDT) schrieb Howard:

This was working for me, and I must have change something to get the variable not set error.

this error comes when no item is found. Change the code:

If Not rngFndPrd Is Nothing Then
rngFndPrd.Offset(0, 5).Copy
Sheets("Sheet1").Range("F100").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteAll, Transpose:=False
End If


Regards
Claus B.

 

[Claus Busch]

Hi Howard,

Am Thu, 3 Oct 2013 10:05:04 +0200 schrieb Claus Busch:

If Not rngFndPrd Is Nothing Then
rngFndPrd.Offset(0, 5).Copy
Sheets("Sheet1").Range("F100").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteAll, Transpose:=False
End If

better without copy and paste:

Application.ScreenUpdating = False
For Each c In ws1Part_Num

Set rngFndPrd = ws2From_Item.Find(c, LookIn:=xlValues, _
lookat:=xlWhole)
If Not rngFndPrd Is Nothing Then
Sheets("Sheet1").Range("F100").End(xlUp)(2) _
= rngFndPrd.Offset(0, 5)
End If

Next
Application.ScreenUpdating = True


Regards
Claus B.

 

[Howard]

Hi Howard,



Am Thu, 3 Oct 2013 10:05:04 +0200 schrieb Claus Busch:










better without copy and paste:



Application.ScreenUpdating = False

For Each c In ws1Part_Num



Set rngFndPrd = ws2From_Item.Find(c, LookIn:=xlValues, _

lookat:=xlWhole)

If Not rngFndPrd Is Nothing Then

Sheets("Sheet1").Range("F100").End(xlUp)(2) _

= rngFndPrd.Offset(0, 5)

End If



Next

Application.ScreenUpdating = True





Regards

Claus B.

Aha, I did indeed change something like I said, it was the data I was using to test the code while I wrote it. Once it worked for me I changed the data a much larger data set and it had no match.

I like the non-copy paste you suggest. I'm sure its possible to include a Transpose or Values.

What would that look like?

Thanks Claus.

 

[Claus Busch]

Hi Howard,

Am Thu, 3 Oct 2013 02:01:14 -0700 (PDT) schrieb Howard:

I like the non-copy paste you suggest. I'm sure its possible to include a Transpose or Values.

to get only the values try:

Application.ScreenUpdating = False
For Each c In ws1Part_Num
Set rngFndPrd = ws2From_Item.Find(c, LookIn:=xlValues, _
lookat:=xlWhole)
If Not rngFndPrd Is Nothing Then
With Sheets("Sheet1")
.Range("F100").End(xlUp).Offset(1, 0).Value _
= rngFndPrd.Offset(0, 5).Value
End With
End If
Next
Application.ScreenUpdating = True

to get the values and transpose the range try:

Application.ScreenUpdating = False
For Each c In ws1Part_Num
Set rngFndPrd = ws2From_Item.Find(c, LookIn:=xlValues, _
lookat:=xlWhole)
If Not rngFndPrd Is Nothing Then
If rngBig Is Nothing Then
Set rngBig = rngFndPrd.Offset(0, 5)
Else
Set rngBig = Union(rngBig, rngFndPrd.Offset(0, 5))
End If
End If
Next
rngBig.Copy
Sheets("Sheet1").Range("F100").End(xlUp).Offset(1, 0) _
.PasteSpecial xlPasteValues, Transpose:=True
Application.ScreenUpdating = True


Regards
Claus B.

 

[Howard]

Hi Howard,



Am Thu, 3 Oct 2013 02:01:14 -0700 (PDT) schrieb Howard:






to get only the values try:



Application.ScreenUpdating = False

For Each c In ws1Part_Num

Set rngFndPrd = ws2From_Item.Find(c, LookIn:=xlValues, _

lookat:=xlWhole)

If Not rngFndPrd Is Nothing Then

With Sheets("Sheet1")

.Range("F100").End(xlUp).Offset(1, 0).Value _

= rngFndPrd.Offset(0, 5).Value

End With

End If

Next

Application.ScreenUpdating = True



to get the values and transpose the range try:



Application.ScreenUpdating = False

For Each c In ws1Part_Num

Set rngFndPrd = ws2From_Item.Find(c, LookIn:=xlValues, _

lookat:=xlWhole)

If Not rngFndPrd Is Nothing Then

If rngBig Is Nothing Then

Set rngBig = rngFndPrd.Offset(0, 5)

Else

Set rngBig = Union(rngBig, rngFndPrd.Offset(0, 5))

End If

End If

Next

rngBig.Copy

Sheets("Sheet1").Range("F100").End(xlUp).Offset(1, 0) _

.PasteSpecial xlPasteValues, Transpose:=True

Application.ScreenUpdating = True





Regards

Claus B.

Okay, got it.
Thanks a ton, Claus.

Regards,
Howard

 

[Howard]

Okay, got it.

Thanks a ton, Claus.



Regards,

Howard

Just noticed as I was pasting in my worksheet, with the transpose code you have introduce a new variable:

If rngBig Is Nothing Then ... etc.

Puzzling, but I do trust your code. Just wondering.

Howard

 

[Claus Busch]

Hi again,

Am Thu, 3 Oct 2013 02:27:23 -0700 (PDT) schrieb Howard:

Okay, got it.

to transpose the range you also can dump the found items in an array:

Application.ScreenUpdating = False
For Each c In ws1Part_Num
Set rngFndPrd = ws2From_Item.Find(c, LookIn:=xlValues, _
lookat:=xlWhole)
If Not rngFndPrd Is Nothing Then
ReDim Preserve varOut(i)
varOut(i) = rngFndPrd.Offset(0, 5).Value
i = i + 1
End If
Next
Sheets("Sheet1").Range("F100").End(xlUp).Offset(1, 0) _
.Resize(columnsize:=UBound(varOut) + 1) = varOut
Application.ScreenUpdating = True


Regards
Claus B.

 

[Claus Busch]

Hi Howard,

Am Thu, 3 Oct 2013 02:48:21 -0700 (PDT) schrieb Howard:

If rngBig Is Nothing Then ... etc.

dim rngBig as Range
This will create a range with all found cells

The new answer:
Dim i as integer
Dim varOut() as Variant


Regards
Claus B.

 

[Howard]

Hi Howard,



Am Thu, 3 Oct 2013 02:48:21 -0700 (PDT) schrieb Howard:






dim rngBig as Range

This will create a range with all found cells



The new answer:

Dim i as integer

Dim varOut() as Variant





Regards

Claus B.

Sweet, thanks a lot.

Regards
Howard