View Full Version : [SOLVED] Need help with getting list of data from unique row

01-28-2015, 04:11 PM

I got unique Ticker values with Frequency=1 in Sheet 2. I want to query these unique values where all the related data in Sheet 1 should be copied in Sheet 3. The sample sheet is attached for better understanding.

In Sheet 2 (Test sheet), you can see unique Ticker value for author where frequency=1. I want help in querying the data in such a way that all the yellow highlighted instances in Sheet 1 (List sheet) should be copied to Sheet 3 (Test2).

Can anyone help me with the VBA query or any formula to achieve this will be great!


01-29-2015, 01:59 AM

remove xlPasteValues to copy formats and formulas!

Sub filter_copy()
Dim i As Long, LastRow As Long

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With


With Worksheets("List")
.AutoFilterMode = False
For i = 2 To Worksheets("Test").Range("C" & Rows.Count).End(xlUp).Row
LastRow = Worksheets("Test2").Range("C" & Rows.Count).End(xlUp).Offset(1).Row
.Cells(1).AutoFilter Field:=3, Criteria1:=Worksheets("Test").Range("C" & i)
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1, 7).Copy
Worksheets("Test2").Range("A" & LastRow).End(xlUp).Offset(1).PasteSpecial xlPasteValues
.AutoFilter.Range.Offset(1, 8).Resize(.AutoFilter.Range.Rows.Count - 1, 1).Copy
Worksheets("Test2").Range("H" & LastRow).PasteSpecial xlPasteValues
Next i
.AutoFilterMode = False
End With

With Application
.EnableEvents = True
End With

End Sub

01-29-2015, 02:04 AM
How about?

Sub CopyHighlighted
Dim xlSource As Worksheet
Dim xlTarget As Worksheet
Dim NextRow As Long
Dim LastRow As Long
Dim i As Long
Set xlSource = ActiveWorkbook.Sheets("List")
Set xlTarget = ActiveWorkbook.Sheets("Test2")
LastRow = xlSource.Cells(xlSource.Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If xlSource.range("A" & i).Interior.Color = RGB(255, 255, 0) Then
NextRow = xlTarget.Cells(xlTarget.Rows.Count, "A").End(xlUp).Row + 1
xlSource.range("A" & i, "J" & i).Copy
xlTarget.range("A" & NextRow, "J" & NextRow).PasteSpecial xlPasteValues
End If
Next i
End Sub

01-29-2015, 04:56 AM
Here's another...

Private Sub CommandButton1_Click()
With range("A1").CurrentRegion
.AutoFilter 3, Application.Transpose(Sheets(2).range("C2:C" & Sheets(2).range("C" & Rows.Count).End(xlUp).Row)), 7
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).Copy
Sheets(3).range("A" & Sheets(3).range("A" & Rows.Count).End(xlUp).Row).Offset(1).PasteSpecial -4163
End With
End Sub

01-29-2015, 08:15 AM
Hi mancubus and apo,

Thanks for your help, your solution really works great!

gmayor, the yellow highlighted color was just for understanding purpose, but anyway thanks for your help too!

Thanks guys, really appreciate your work!

01-29-2015, 12:30 PM
Is this what you ultimately wanted?

01-29-2015, 12:32 PM
goto your List tab and click on a name