The sheet is concerned with Col A, B, C and returning values to col D.

I run this code as is and it finds the first occurrence of TJ in col C and returns 122; in col D. However, it does seem to run the full length of col D as the first occurrence of a "TJ" is row nine and the code runs for about 1.5 seconds (or a bit less) given the 2400+ rows in col D.

I need it to find all occurrences of TJ and return the 122; (with semi-colon) in col D

Examples of what is in each column is adjacent to the Dim statements. Where KL & 98; are on same row, WK & 95; are on same row TJ & 394; are on same row and on down for about 25 rows, a string in A and number w/; next to it.

So with this entry in col C "MIRROR TYPE TJ KIT" I would expect col D to show 122;

And with this entry in col C "MIRROR KIT BLK 87-02 YJ/TJ" I would expect col D to show 394; 122;

With this in col C "ACC KIT HOOD SS 98-06" col D is blank because nothing in col A relates to anything in that particular string.

So, D can be blank, have one number/; or two number/; and maybe three number/;.

Code as is (in a bit of a test mode) has "TJ" and "122;" hard coded. So this is where I was going with "For Each aMod In Range("A1:A" & lngLstRow)".

Take each of the values in col A and look in col C for it and if there enter in col D the adjacent col B number/; of the col A value.

Thanks.
Howard

Option Explicit

Sub Auto_Mate()
Dim lngLstRow As Long
Dim aMod As Range ' Col A KJ, WK, TJ, YJ CJ
Dim ids As Range ' Col B 98; 95; 122; 394; 393;
Dim shDes As Range ' Col C MIRROR TYPE TJ KIT
' MIRROR KIT BLK 87-02 YJ/TJ
' ACC KIT HOOD SS 98-06
Dim aModCol As Range ' Col A
Dim idsCol As Range ' Col B
Dim shDesCol As Range ' Col C

lngLstRow = ActiveSheet.UsedRange.Rows.Count

With Sheet1
'For Each aMod In Range("A1:A" & lngLstRow)

Set shDesCol = .Columns(3).Find(what:="TJ", After:=.Cells(1, 3), _
LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
shDesCol.Offset(0, 1) = "122;"

If Not shDesCol Is Nothing Then Application.Goto shDesCol, True

'Next 'aMod
End With
End Sub