View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.misc
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Lookup all values within multiple columns and copy to new colu

I think this is what you really wanted. Original request wasn't specific
enough. Sorry

Sub copycols()

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set ColARange = Range(Cells(1, "A"), Cells(LastRow, "A"))
LastRow = Cells(Rows.Count, "J").End(xlUp).Row
Set ColJRange = Range(Cells(1, "J"), Cells(LastRow, "J"))
LastRow = Cells(Rows.Count, "S").End(xlUp).Row
Set ColSRange = Range(Cells(1, "S"), Cells(LastRow, "S"))

'get last row in column W
LastRow = Cells(Rows.Count, "W").End(xlUp).Row
If (LastRow = 1) And IsEmpty(Cells(1, "W")) Then
RowCount = 1
Else
RowCount = LastRow + 1
End If

For Each Cell In ColSRange

For Each CellA In ColARange
If Cell.Value = CellA.Value Then
Cells(RowCount, "W") = Cell.Value
RowCount = RowCount + 1
End If
Next CellA

For Each CellJ In ColJRange
If Cell.Value = CellJ.Value Then
Cells(RowCount, "W") = Cell.Value
RowCount = RowCount + 1
End If
Next CellJ

Next Cell
End Sub



"Tommy" wrote:

a nice piece of code, but it does not do what I need. Your code finds
all unique tags within the defined range. I require an output of all
identical tags within a range. say for example there are 10 cells in a
single column range and 4 of them contain the same tag, "06TI1845.PV"
for example. Well I need the output in column W to list 06TI1845.PV 4
times.....