Excel VBA

[12mcarchedi]

I am trying to automate the process of copy and pasting data from on column to another using a macro. What I would like to do is as follows and any help would be appreciated. I am completely new to VBA and macros so an explanation on how it works would be great as I am looking to learn.

1) Find date in column L on sheet "Dividends" that is less than the date in cell A2 on sheet "Dates"
2)Once the first date is found, Copy the date cell in column L and the 3 cells to the right to the next open cell in column Q on sheet "Dividends"
3) Repeat this process for all cells in column L whose date is less than A2 on "Dates"

If this is not clear I can attach a sample file later, but would rather do that if it is needed.

Thanks for any help!

 

[12mcarchedi]

This is what the sheet looks like. All of the information on the left is linked from an outside source, and I am trying to hard code all of the dividends that fall before the cell A2 date in the second column under Dividend Record.

L	M	N	O	P	Q
Record Date 'Date'	Ticker	Total DvD Value	Sector		Dividend Record
--	DIS	1989.5	CD		Date	Ticker	Amount	Sector
--	GPS	522.5	CD		1/16/2015	EOG	91.6225	E
--	SNI	217.8	CD
2/12/2015	TJX	231.875	CD
--	VLKAY	1973.232	CD
--	WHR	536.25	CD
--	XLY	460.2298	CD
--
--
--
--	BUD	745.1574	CS
1/22/2015	CVS	402.5	CS
2/16/2015	KR	323.75	CS
--	KRFT	715	CS
1/23/2015	PG	884.95	CS
--	RAI	489.1	CS
--	TAP	333	CS
--
--
--
--	CVX	749	E
1/16/2015	EOG	91.6225	E
1/30/2015	EPD	388.5	E
--	HAL	291.78	E
--	MRO	487.83	E
--	NOV	223.1	E
--	VLO	466.125	E
--	XOM	1266.15	E

<tbody>
</tbody>

Again,
Thanks for the help in advance.
MJC

 

[cdchapman]

MJC,


Based on the data layout you've provided, see if the macro below works for you:

Sub CopyData()


    Dim wksDivi As Worksheet                'reference to Dividends worksheet
    Dim wksDates As Worksheet               'reference to Date worksheet
    Dim varDateToSearch As Variant       'holds search date
    Dim intSearchRow As Integer              'loops through rows to search
    Dim intNextRow As Integer                 'holds next destination row on Date worksheet
    
    'set references to worksheets
    Set wksDivi = ThisWorkbook.Worksheets("Dividends")
    Set wksDates = ThisWorkbook.Worksheets("Date")
    
    'store the date to be searched
    varDateToSearch = wksDate.Range("A2").Value
    
    'if the date to be searched is blank then stop the execution
    If varDateToSearch = "" Then Exit Sub
    
    'clear the contents of the destination cells
    wksDates.Range("B2:D65000").ClearContents
    
    'loop through the dividend sheet, identifying matching rows
    intNextRow = wksDates.Cells(Rows.Count, "B").End(xlUp).Row + 1
    For intSearchRow = 2 To wksDivi.Cells(Rows.Count, "M").End(xlUp).Row
        If wksDivi.Range("L" & intSearchRow).Value <> "" Then
            If wksDivi.Range("L" & intSearchRow).Value <= varDateToSearch Then
                wksDivi.Range("M" & intSearchRow & ":O" & intSearchRow).Copy Destination:=wksDates.Range("B" & intNextRow)
                intNextRow = intNextRow + 1
            End If
        End If
    Next intSearchRow
    
    'Release the references
    Set wksDates = Nothing
    Set wksDivi = Nothing
    
End Sub

Basically, what this code does is as follows:


1. Set a reference to the two worksheets (Dividends and Dates), so that they can be referenced easier later on in the code.
2. Stores the date to look for in a variable called varDateToSearch (which is a variant data type).
3. Clears any existing values in columns B to D on the Dates worksheet.
4. Finds the last row in the dividends worksheet that has data (I've used column M for this purpose as I notice not all rows have a date).
5. Loops through the Dividends sheet from row 2 to the last row found and checks that the Record Date is not blank AND the Record Date is equal to or less than the date held in the varDateToSearch variable. If both of these checks are true then it copies the cell contents from column M to O of that row to the next available row on the Dates worksheet. This is repeated until the last row is reached.
6. Finally tidies up by releasing the memory used to store the sheet references in 1. above.




Chris

 

[12mcarchedi]

If I was looking to paste the information on the Dividends sheet starting column Q instead of on the Dates page, would this do the trick? or would I need to change something else in the code?

Thanks for the help,
MJC

wksDivi.Range("M" & intSearchRow & ":O" & intSearchRow).Copy Destination:=wksdivi.Range("Q" & intNextRow)

 

[12mcarchedi]

Thanks for all your help, I just have a couple more questions. First, If I was looking to paste the information in column Q on the dividends sheet like I said in my last post, but have it start on row 3, and once row 3 is full, paste on row 4, what would that look like? I am trying to make a list of all the dividends I receive during the entire year, so if a company has a dividend this week, I am looking for it to paste that information right after the last dividend received on the list, not on the same row in column Q. Second and perhaps more easy, what would change if I am looking to paste values instead of copying the formulas?

Would the two combined look something like this? I underlined what I changed. Again, thanks for all the help.

Sub Dividends()




    Dim wksDivi As Worksheet                'reference to Dividends worksheet
    Dim wksDates As Worksheet               'reference to Date worksheet
    Dim varDateToSearch As Variant       'holds search date
    Dim intSearchRow As Integer              'loops through rows to search
    Dim intNextRow As Integer                 'holds next destination row on Date worksheet
[U]    Dim lastrow As Long[/U]

    'set references to worksheets
    Set wksDivi = ThisWorkbook.Worksheets("Dividends")
    Set wksDates = ThisWorkbook.Worksheets("Dates")
    
    'store the date to be searched
    varDateToSearch = wksDates.Range("A2").Value
    
    'if the date to be searched is blank then stop the execution
    If varDateToSearch = "" Then Exit Sub
    
    
    
    'loop through the dividend sheet, identifying matching rows
    intNextRow = wksDates.Cells(Rows.Count, "B").End(xlUp).Row + 1
    For intSearchRow = 2 To wksDivi.Cells(Rows.Count, "M").End(xlUp).Row
        If wksDivi.Range("L" & intSearchRow).Value <> "" Then
            If wksDivi.Range("L" & intSearchRow).Value <= varDateToSearch Then
[U]            lastrow = Sheets("Dividends").Range("Q65536").End(xlUp).Row + 1[/U]
            wksDivi.Range("L" & intSearchRow & ":O" & intSearchRow).Copy
[U]            wksDivi.Range("Q" & lastrow).PasteSpecial xlPasteValues[/U]
            intNextRow = intNextRow + 1
            End If
        End If
    Next intSearchRow
    
    'Release the references
    Set wksDates = Nothing
    Set wksDivi = Nothing
    
End Sub

 

[cdchapman]

Assuming the cells Q1 and Q2 are not blank, then your amended code should work and paste values only starting in row 3 (and thereafter in the next available blank row). However, you don't really need to declare another variable to hold the last row, you can just use the existing intNextRow variable with a few changes as below:

Sub Dividends()








    Dim wksDivi As Worksheet                'reference to Dividends worksheet
    Dim wksDates As Worksheet               'reference to Date worksheet
    Dim varDateToSearch As Variant       'holds search date
    Dim intSearchRow As Integer              'loops through rows to search
    Dim intNextRow As Integer                 'holds next destination row on Date worksheet


    'set references to worksheets
    Set wksDivi = ThisWorkbook.Worksheets("Dividends")
    Set wksDates = ThisWorkbook.Worksheets("Dates")
    
    'store the date to be searched
    varDateToSearch = wksDates.Range("A2").Value
    
    'if the date to be searched is blank then stop the execution
    If varDateToSearch = "" Then Exit Sub
    
    
    
    'loop through the dividend sheet, identifying matching rows
    For intSearchRow = 2 To wksDivi.Cells(Rows.Count, "M").End(xlUp).Row
        If wksDivi.Range("L" & intSearchRow).Value <> "" Then
            If wksDivi.Range("L" & intSearchRow).Value <= varDateToSearch Then
            intNextRow = Sheets("Dividends").Range("Q65536").End(xlUp).Row + 1
            wksDivi.Range("L" & intSearchRow & ":O" & intSearchRow).Copy
            wksDivi.Range("Q" & intNextRow).PasteSpecial xlPasteValues
            End If
        End If
    Next intSearchRow
    
    'Release the references
    Set wksDates = Nothing
    Set wksDivi = Nothing
    
End Sub

Also this code assumes your search date is still in cell A2 on the Dates worksheet.

Chris