Lookup all values within multiple columns and copy to new column

[Tommy]

I have a list of strings in column A and column J. Because the number
in each column is variable, the whole column should be referenced. I
would like to lookup all instances of a string that is in column S and
then have each string found output to column W. There may be e.g. 10
strings that match the string I want, i therefore want 10 strings
output into W. How do I go about this?

Thanks,

Tom

 

[Joel]

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

Set FoundinA = ColARange.Find(what:=cell, LookIn:=xlValues)
Set FoundinJ = ColJRange.Find(what:=cell, LookIn:=xlValues)
If (Not FoundinA Is Nothing) Or (Not FoundinJ Is Nothing) Then
Cells(RowCount, "W") = cell
RowCount = RowCount + 1
End If
Next cell
RowCount = 1
End Sub

 

[Tommy]

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.....

 

[Joel]

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