On Saturday, September 28, 2013 3:42:57 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Sat, 28 Sep 2013 03:33:06 -0700 (PDT) schrieb Howard:



I'll give it a go. I'm using the codes on a small test data set, actual use could be around 5500+ rows.



can your search string be found more than once? Then try:



Sub TheUnionOf3()

Dim varOut() As Variant

Dim sFndPrd As String

Dim c As Range

Dim LRow As Long

Dim firstaddress As String

Dim i As Integer

Dim j As Integer

Dim myCount As Integer



sFndPrd = Application.InputBox("Enter Col A Item.", _

"Col A Finder", , , , , , 2)



LRow = Cells(Rows.Count, 1).End(xlUp).Row

myCount = WorksheetFunction.CountIf(Range("A1:A" & LRow), sFndPrd)

With Range("A1:A" & LRow)

i = 1

Set c = .Find(sFndPrd, LookIn:=xlValues)

If Not c Is Nothing Then

firstaddress = c.Address

Do

ReDim Preserve varOut(myCount, 4)

varOut(i, 1) = c.Offset(0, 1)

varOut(i, 2) = c.Offset(0, 2)

varOut(i, 3) = c.Offset(0, 4)

varOut(i, 4) = c.Offset(0, 5)

Set c = .FindNext(c)

i = i + 1

Loop While Not c Is Nothing And c.Address < firstaddress

End If

.Cells(Rows.Count, "K").End(xlUp)(2) _

.Resize(myCount, 4) = varOut

' .Cells(Rows.Count, "K").End(xlUp)(2) _

' .Resize(4, myCount) = WorksheetFunction.Transpose(varOut)

End With

End Sub





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

I was just ready to post back after trying the find method, for that very reason.

The search string will almost always be in multiples and the return values for identical strings will be different as the code goes down the list in column A. So the end product will be a progression of changes relative to the search string as it is found on down the line.

I'll give this newest code a test flight.

I would like the option to produce the out come list to another sheet also.

Would it look something like this if data was on sheet 10?


Sheets("Sheet11").Cells(Rows.Count, "K").End(xlUp)(2) _
.Resize(myCount, 4) = varOut

Howard