I can't seam to figure out how to get this to loop until
the words "No Match" are not found in the limited search
for range. I can get to loop a couple of times but once
it does not find a match any further it crashes. Run time
13 type mismatch is the most common.


Sub Add_New_CAD_Customer()

Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFirst As Range
Dim celltofind As Range
Set celltofind = Cells.Find(What:="No Match",
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)

Set wks = ActiveSheet
Set rngToSearch = wks.Range("AF3:AF20")
Set rngFound = rngToSearch.Find("No Match", , xlValues,
xlPart)

If Not rngFound Is Nothing Then
Set rngFirst = rngFound

Do
Range("A3:T3").Select
Selection.Insert Shift:=xlDown
Range("A4:T4").Select
Selection.Copy
Range("A3").Select
Selection.PasteSpecial
Paste:=xlPasteFormats

Set rngFound = rngToSearch.FindNext(rngFound)
Set rngToSearch = wks.Range("AF3:AF20")
Set rngFound = rngToSearch.Find("No Match", ,
xlValues, xlPart)
rngToSearch.Find("No Match").Select

ActiveCell.ClearContents
ActiveCell.Offset(0, -6).Range
("A1:B1").Select
Selection.Copy
Range("B3").Select
Selection.PasteSpecial
Paste:=xlPasteValues
Loop Until celltofind is empty
End If
End Sub

Any suggestions
Pete W

What are you trying to do? I get the part where you are trying to find the
words "no Match". Based on finding that you want to do what exactly?

"Pete" wrote:

I can't seam to figure out how to get this to loop until
the words "No Match" are not found in the limited search
for range. I can get to loop a couple of times but once
it does not find a match any further it crashes. Run time
13 type mismatch is the most common.


Sub Add_New_CAD_Customer()

Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFirst As Range
Dim celltofind As Range
Set celltofind = Cells.Find(What:="No Match",
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)

Set wks = ActiveSheet
Set rngToSearch = wks.Range("AF3:AF20")
Set rngFound = rngToSearch.Find("No Match", , xlValues,
xlPart)

If Not rngFound Is Nothing Then
Set rngFirst = rngFound

Do
Range("A3:T3").Select
Selection.Insert Shift:=xlDown
Range("A4:T4").Select
Selection.Copy
Range("A3").Select
Selection.PasteSpecial
Paste:=xlPasteFormats

Set rngFound = rngToSearch.FindNext(rngFound)
Set rngToSearch = wks.Range("AF3:AF20")
Set rngFound = rngToSearch.Find("No Match", ,
xlValues, xlPart)
rngToSearch.Find("No Match").Select

ActiveCell.ClearContents
ActiveCell.Offset(0, -6).Range
("A1:B1").Select
Selection.Copy
Range("B3").Select
Selection.PasteSpecial
Paste:=xlPasteValues
Loop Until celltofind is empty
End If
End Sub

Any suggestions
Pete W