Code error
 

Hi all,

I am having trouble running the code below. An error keeps occurrin
with this line:

rng.Offset(1, 0).ClearContents

Any ideas....please???

Cheers!!!

Private Sub Commandbutton1_click()
CopyData Range("C13:C24"), "BASE MACHINE"
CopyData Range("C71:C85"), "CONTROL INCLUSIONS - UNIT 1"
CopyData Range("C91:C91"), "FEEDER INCLUSIONS - UNIT 1"
CopyData Range("C98:C112"), "FOLDING UNIT INCLUSIONS - UNIT 1"
CopyData Range("C142:C152"), "CONTROL INCLUSIONS - UNIT 2"
CopyData Range("C158:C168"), "FOLDING UNIT INCLUSIONS - UNIT 2"
CopyData Range("C181:C183"), "KNIFE INCLUSIONS - UNIT 2"
CopyData Range("C196:C200"), "KNIFE INCLUSIONS - UNIT 3"
End Sub
Private Sub CopyData(rngC As Range, Target As String)
Dim rng As Range, cell As Range
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
nrow = Application.CountIf(rngC, "0")
If nrow = 0 Then Exit Sub
Set Sh = Worksheets("sheet1")
Set rng = Sh.Columns(1).Find(What:=Target, _
After:=Sh.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set rng3 = rng
'Worksheets("quote2").Unprotect Password:="jenjen1"
rng.Offset(1, 0).ClearContents
If Application.CountA(rng3) 2 Then
Else
Set rng3 = rng.Offset(2, 0)
End If
rw = rng3.Row
rng3.Resize(nrow * 2, 1).EntireRow.Insert
For Each cell In rngC
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Resize(1, 2).Copy _
Destination:=Sh.Cells(rw, 1)
rw = rw + 2
End If
End If
End If
Next
'Worksheets("quote2").Protect Password:="jenjen1"
End Su

--
Message posted from http://www.ExcelForum.com

Code error
 

Are you sure that rng is actually an object. Try

If Not rng Is Nothing Then
rng.Offset(1, 0).ClearContents
Else
Msgbox "Nothing found"
End If

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"gavmer " wrote in message
...
Hi all,

I am having trouble running the code below. An error keeps occurring
with this line:

rng.Offset(1, 0).ClearContents

Any ideas....please???

Cheers!!!

Private Sub Commandbutton1_click()
CopyData Range("C13:C24"), "BASE MACHINE"
CopyData Range("C71:C85"), "CONTROL INCLUSIONS - UNIT 1"
CopyData Range("C91:C91"), "FEEDER INCLUSIONS - UNIT 1"
CopyData Range("C98:C112"), "FOLDING UNIT INCLUSIONS - UNIT 1"
CopyData Range("C142:C152"), "CONTROL INCLUSIONS - UNIT 2"
CopyData Range("C158:C168"), "FOLDING UNIT INCLUSIONS - UNIT 2"
CopyData Range("C181:C183"), "KNIFE INCLUSIONS - UNIT 2"
CopyData Range("C196:C200"), "KNIFE INCLUSIONS - UNIT 3"
End Sub
Private Sub CopyData(rngC As Range, Target As String)
Dim rng As Range, cell As Range
Dim rng1 As Range, rng2 As Range
Dim rng3 As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
nrow = Application.CountIf(rngC, "0")
If nrow = 0 Then Exit Sub
Set Sh = Worksheets("sheet1")
Set rng = Sh.Columns(1).Find(What:=Target, _
After:=Sh.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set rng3 = rng
'Worksheets("quote2").Unprotect Password:="jenjen1"
rng.Offset(1, 0).ClearContents
If Application.CountA(rng3) 2 Then
Else
Set rng3 = rng.Offset(2, 0)
End If
rw = rng3.Row
rng3.Resize(nrow * 2, 1).EntireRow.Insert
For Each cell In rngC
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Resize(1, 2).Copy _
Destination:=Sh.Cells(rw, 1)
rw = rw + 2
End If
End If
End If
Next
'Worksheets("quote2").Protect Password:="jenjen1"
End Sub


---
Message posted from http://www.ExcelForum.com/

Code error
 

hi Bob,

Thank you. Can you show me how to implement this into my existing code
Woud it be worthwhile seeing my workbook??

Cheers!!!

--
Message posted from http://www.ExcelForum.com

Code error
 

Hi again,

I tried what you said and yes, the error message appeared.

????????

--
Message posted from http://www.ExcelForum.com

Code error
 

gavmer,
Adjust your find statement,

Set rng = Sh.Columns(1).Find(What:=Target, _
After:=Sh.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If rng Is Nothing Then
Msgbox Target & "Not found"
Exit Sub
End If

"gavmer " wrote in message
...
Hi again,

I tried what you said and yes, the error message appeared.

?????????


---
Message posted from http://www.ExcelForum.com/