Hi Howard,

Am Thu, 12 Dec 2013 19:45:57 -0800 (PST) schrieb Howard:

Trying to get a message to display if no match is found in this
For Each c In ACM.

try:

Sub PlugedIn2()
Dim FindCable As String
Dim ACM As Range
Dim c As Range
Dim lr As Long
Dim i As Integer
Dim firstaddress As String

With Sheets("Find Cables")
For i = 3 To 13 Step 2
FindCable = FindCable & .Range("C" & i) & " "
Next
End With

FindCable = Trim(FindCable)

With Sheets("all cables")
lr = .Cells(.Rows.Count, 6).End(xlUp).Row
Set ACM = .Range("F2:F" & lr)
End With

If WorksheetFunction.CountIf(ACM, FindCable) = 0 Then
MsgBox "No Match"
Exit Sub
End If

With Sheets("Find Cables")
Set c = ACM.Find(FindCable, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
.Range("A" & Rows.Count).End(xlUp)(2) = c.Offset(, -5)
.Range("B" & Rows.Count).End(xlUp)(2) = c.Offset(, -4)
.Range("C" & Rows.Count).End(xlUp)(2) = c.Offset(, -3)
.Range("D" & Rows.Count).End(xlUp)(2) = c.Offset(, -2)
.Range("E" & Rows.Count).End(xlUp)(2) = c.Offset(, 9)
.Range("F" & Rows.Count).End(xlUp)(2) = c.Offset(, 10)
.Range("G" & Rows.Count).End(xlUp)(2) = c.Offset(, 12)

Set c = ACM.FindNext(c)
Loop While Not c Is Nothing And c.Address < firstaddress
End If
End With

End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2