J
Jeff
Please help this one is very tough to figure out. and
I'm really stuck.
.
I search for a word in a cell G2 with many words.
When found I copy the entire cell and cell A2 to another sheet.
See error message I'm getting at '**ERROR' in code below
Sub Search_Copy()
Dim c As Range
Dim rngToSearch As Range
Dim rngFound As Range
Dim MyDesc, MyName, reset
reset = 23
Sheets("Input data").Select
Set rngToSearch = Sheets("Input data").Columns("G")
On Error Resume Next
Set rng = Range("G2", Cells(Rows.Count, "G").End(xlUp))
Set rngFound = rngToSearch.Find(What:="service", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=True)
On Error GoTo 0
For Each c In rng
'** Search, find string within string in cell, copy into another sheet
If Len(ActiveCell.Value) <> 0 Then
'** find only word "service" in cell G2 containing many words
str1 = InStr(1, c.Value, "service")
'** if found the word 'service' then continue
If str1 <> 0 Then
Sheets("Service List").Select
'** format positioning of data
MyName = CVar(reset)
MyName = "C" & MyName
MyDesc = CVar(reset + 2)
MyDesc = "C" & MyDesc
'** copy ALL information in G2 sheet 'input data' into C25 sheet
'Service List'
Range(MyDesc).Value = c.Value
With Sheets("Service List")
'** ERROR object or With Variable not set
'** copy ALL information in corresponding A2 sheet 'Input
data' into C23 _
' sheet 'Service List'
.Range(MyName).Value = rngFound.offset(2, 7).Value
End With
'** loop and format data
reset = reset + 8
End If
End If
Next
End Sub
I'm really stuck.
I search for a word in a cell G2 with many words.
When found I copy the entire cell and cell A2 to another sheet.
See error message I'm getting at '**ERROR' in code below
Sub Search_Copy()
Dim c As Range
Dim rngToSearch As Range
Dim rngFound As Range
Dim MyDesc, MyName, reset
reset = 23
Sheets("Input data").Select
Set rngToSearch = Sheets("Input data").Columns("G")
On Error Resume Next
Set rng = Range("G2", Cells(Rows.Count, "G").End(xlUp))
Set rngFound = rngToSearch.Find(What:="service", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=True)
On Error GoTo 0
For Each c In rng
'** Search, find string within string in cell, copy into another sheet
If Len(ActiveCell.Value) <> 0 Then
'** find only word "service" in cell G2 containing many words
str1 = InStr(1, c.Value, "service")
'** if found the word 'service' then continue
If str1 <> 0 Then
Sheets("Service List").Select
'** format positioning of data
MyName = CVar(reset)
MyName = "C" & MyName
MyDesc = CVar(reset + 2)
MyDesc = "C" & MyDesc
'** copy ALL information in G2 sheet 'input data' into C25 sheet
'Service List'
Range(MyDesc).Value = c.Value
With Sheets("Service List")
'** ERROR object or With Variable not set
'** copy ALL information in corresponding A2 sheet 'Input
data' into C23 _
' sheet 'Service List'
.Range(MyName).Value = rngFound.offset(2, 7).Value
End With
'** loop and format data
reset = reset + 8
End If
End If
Next
End Sub