CODEWITHSUNDEEP
excelvba
Chunsey
Chunsey

Reputation: 3

Copying and Pasting specific cell values to a different sheet

I am a newbie but fascinated with what Excel VBA can do! I need help with creating a macro that copies and pastes the first three dates for each symbol to a new sheet(Sheet2).

Below is the data(Sheet1) I have...

A       8/17/2013
A       9/21/2013
A      11/16/2013
A       1/18/2014
A       2/22/2014
A       1/17/2015
AA       8/9/2013
AA      8/17/2013
AA      9/21/2013
AA     10/19/2013
AA      1/18/2014
AA      1/17/2015
AAN     8/17/2013
AAN     9/21/2013
AAN    11/16/2013
AAN     2/22/2014
AAP     8/17/2013
AAP     9/21/2013
AAP    12/21/2013
AAP     1/18/2014
AAP     3/22/2014
AAP     1/17/2015
AAPL     8/9/2013
AAPL    8/17/2013
AAPL    8/23/2013
AAPL    8/30/2013
AAPL     9/6/2013
AAPL    9/21/2013
AAPL   10/19/2013
AAPL   11/16/2013
AAPL    1/18/2014
AAPL    4/19/2014
AAPL    1/17/2015
AAWW    8/17/2013
AAWW    9/21/2013
AAWW   11/16/2013
AAWW    2/22/2014

The problem is I do not want all the symbols from Sheet1. I have specific symbols I want in Sheet2. Also, in sheet2, I already have three rows for each symbol with the symbols names copied and pasted.

So what I want is something like if a symbol in Sheet 1 equals a symbol in Sheet 2 then copy the date but I want the first three dates not the first date repeated 3 times..

A desired sheet2 looks like this

A       8/17/2013
A       9/21/2013
A      11/16/2013
AAWW    8/17/2013
AAWW    9/21/2013
AAWW   11/16/2013

Remember, I have the left column with Symbols already. I need the matching-first three dates for each symbol..

Can anyone help me with this? I greatly appreciate anyone's help in advance.

Upvotes: 0

Views: 1869

Answers (3)

SeanC
SeanC

Reputation: 15923

Formula version...

use Match to find what line the first symbol appears, and use index to find the data. I am assuming that your symbols are in column A, and dates in column B

For the first date, =INDEX(Sheet1!B:B,MATCH(A1,sheet1!A:A,0)+0,1)
for the 2nd date, move down 1 from the first match: =INDEX(Sheet1!B:B,MATCH(A2,sheet1!A:A,0)+1,1)
and repeat for as many matches as you want: 

=INDEX(Sheet1!B:B,MATCH(A3,sheet1!A:A,0)+2,1)
=INDEX(Sheet1!B:B,MATCH(A4,sheet1!A:A,0)+3,1)
=INDEX(Sheet1!B:B,MATCH(A5,sheet1!A:A,0)+4,1)

once you have enough, start at +0 again

Upvotes: 0

chuff
chuff

Reputation: 5866

No need at all for VBA, this is handled readily by a worksheet formula:

  =OFFSET(Sheet1!$A$1,MATCH(A1,Sheet1!$A$1:$A$37,0)-1+MOD(ROW(A1)+2,3),1,1,1)

The formula assumes that both the source data and the result set begin in row 1 of their respective sheets. If the result set does not begin in row 1, you will need to adjust the MOD(ROW(A1)+2),3) clause of the formula, which should produce the series 0, 1, 2, 0, 1, ... etc. as it is copied down the sheet.


enter image description here

Upvotes: 0

tigeravatar
tigeravatar

Reputation: 26640

Using your provided sample data, and assuming that you are on Excel 2007 or higher and your data has row 1 as a header row so that actual data starts in row 2, use this formula in 'Sheet2' cell B2 and copy down (you will need to format as date):

=INDEX(Sheet1!$B$2:$B$38,MATCH(1,INDEX((Sheet1!$A$2:$A$38=A2)*(COUNTIFS(A$1:A1,A2,B$1:B1,Sheet1!$B$2:$B$38)=0),),0))

And here is a VBA solution if preferred:

Sub tgr()

    Dim cllSymbols As Collection
    Dim wsData As Worksheet
    Dim wsDest As Worksheet
    Dim rngSymbols As Range
    Dim SymbolCell As Range
    Dim rngFound As Range
    Dim arrData() As Variant
    Dim varSymbol As Variant
    Dim strFirst As String
    Dim DataIndex As Long
    Dim i As Long

    Set cllSymbols = New Collection
    Set wsData = Sheets("Sheet1")
    Set wsDest = Sheets("Sheet2")
    Set rngSymbols = wsDest.Range("A2", wsDest.Cells(Rows.Count, "A").End(xlUp))
    If rngSymbols.Row < 2 Then Exit Sub 'No data

    On Error Resume Next
    For Each SymbolCell In rngSymbols.Cells
        If Len(SymbolCell.Text) > 0 Then cllSymbols.Add SymbolCell, SymbolCell
    Next SymbolCell
    On Error GoTo 0

    If cllSymbols.Count > 0 Then
        ReDim arrData(1 To cllSymbols.Count * 3)
        For Each varSymbol In cllSymbols
            Set rngFound = wsData.Columns("A").Find(varSymbol, , xlValues, xlWhole)
            If Not rngFound Is Nothing Then
                i = 0
                strFirst = rngFound.Address
                Do
                    i = i + 1
                    If i > 3 Then Exit Do
                    DataIndex = DataIndex + 1
                    arrData(DataIndex) = wsData.Cells(rngFound.Row, "B").Text
                    Set rngFound = wsData.Columns("A").Find(varSymbol, rngFound, xlValues, xlWhole)
                Loop While rngFound.Address <> strFirst
            End If
        Next varSymbol
        rngSymbols.Offset(, 1).Value = Application.Transpose(arrData)
    End If

    Set cllSymbols = Nothing
    Set wsData = Nothing
    Set wsDest = Nothing
    Set rngSymbols = Nothing
    Set SymbolCell = Nothing
    Set rngFound = Nothing
    Erase arrData

End Sub

Upvotes: 1

Related Questions