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



Am Fri, 27 Sep 2013 23:55:51 -0700 (PDT) schrieb Howard:



Can I copy FndPrd to a list on the same sheet and/or to another sheet.

What I have gives me TRUE in K2 and I have marching ants around the

.Union arguments 1 & 2 and 3 & 4 on the sheet.



try:



Sub TheUnionOf2()

Dim rngFndPrd As Range

Dim sFndPrd As String

Dim c As Range



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

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



For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

If c = sFndPrd Then

Set rngFndPrd = Union(c.Offset(0, 1), c.Offset(0, 2), _

c.Offset(0, 4), c.Offset(0, 5))

rngFndPrd.Copy

Range("K100").End(xlUp).Offset(1, 0).PasteSpecial _

Paste:=xlPasteAll, Transpose:=True

End If

Next

End Sub



or:



Sub TheUnionOf()

Dim strFndPrd As String

Dim sFndPrd As String

Dim varOut As Variant

Dim c As Range



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

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



For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

If c = sFndPrd Then

strFndPrd = c.Offset(0, 1) & "," & c.Offset(0, 2) & "," & _

c.Offset(0, 4) & "," & c.Offset(0, 5)

varOut = Split(strFndPrd, ",")

Range("K100").End(xlUp).Offset(1, 0) _

.Resize(rowsize:=UBound(varOut) + 1) = _

WorksheetFunction.Transpose(varOut)

End If

Next

End Sub





Regards

Claus B.

--

Win XP PRof SP2 / Vista Ultimate SP2

Office 2003 SP2 /2007 Ultimate SP2

Thanks, Claus. Both run smooth and good as gold.

Regards,
Howard