Vba code to copy & paste values from one sheet to another if condition is met

[Knight_777]

Hi,
Below is a simplified example of tables I have. the 1st tab is in one sheet and the 2nd one is in a different sheet.
Basically what I wont to do is to write a VBA code to copy & paste the value shown in tab 1 to tab 2 in the 2nd sheet if one codition is met, which is the date. In other words, I wont to get the values from tab 1 to be copied in the 2nd tab (which has multiple columns) only if the date in the header of the column match the date as shown in the first cell "2018-03-09" of tab 1. But also, I don't want anything to be copied in the other columns if the criteria is not met, as there will be formulas in those columns which I want preserve if the date is not matching.

I know it sounds complicated, but thought it would be possible to do it through a code.

I would appreciate if anyone could help me on this one, as I'm new to VBA.


Thank you in advance.

Today:	2018-03-09
Daily Road Tax Reserve (-)	-225500
Road Tax Reserve Release (+)	5000000
Excess Availability (-/+)	-1600000
Account -1
Account -2
Account -3
Account -4

<tbody>
</tbody>

	2018-03-05	2018-03-06	2018-03-07	2018-03-08	2018-03-09	2018-03-10	2018-03-11	2018-03-12	2018-03-13
Daily Road Tax Reserve (-)
Road Tax Reserve Release (+)
Excess Availability (-/+)
Account -1
Account -2
Account -3
Account -4
Total Collections

<tbody>
</tbody>

 

[mumps]

Make sure that cell B1 in Sheet1 is formatted as a date in the format "yyyy-mm-dd" and the same for the dates in Sheet2. Then try this macro:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim strdate As String
    strdate = Sheets("Sheet1").Range("B1")
    Dim foundDate As Range
    Set foundDate = Sheets("Sheet2").Rows(1).Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        Sheets("Sheet1").Range("B2:B" & LastRow).Copy Sheets("Sheet2").Cells(2, foundDate.Column)
    End If
    Application.ScreenUpdating = True
End Sub

 

[Knight_777]

Make sure that cell B1 in Sheet1 is formatted as a date in the format "yyyy-mm-dd" and the same for the dates in Sheet2. Then try this macro:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim strdate As String
    strdate = Sheets("Sheet1").Range("B1")
    Dim foundDate As Range
    Set foundDate = Sheets("Sheet2").Rows(1).Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        Sheets("Sheet1").Range("B2:B" & LastRow).Copy Sheets("Sheet2").Cells(2, foundDate.Column)
    End If
    Application.ScreenUpdating = True
End Sub

Thank you for the quick reply.
What should I change in the code to get the data copied and pasted as value only without altering the destination cells format?

Thanks

 

[Knight_777]

Make sure that cell B1 in Sheet1 is formatted as a date in the format "yyyy-mm-dd" and the same for the dates in Sheet2. Then try this macro:

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim strdate As String
    strdate = Sheets("Sheet1").Range("B1")
    Dim foundDate As Range
    Set foundDate = Sheets("Sheet2").Rows(1).Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        Sheets("Sheet1").Range("B2:B" & LastRow).Copy Sheets("Sheet2").Cells(2, foundDate.Column)
    End If
    Application.ScreenUpdating = True
End Sub

Hi I tried the code but it's not working it breakdown at the below step

Sheets("Sheet1").Range("B2:B" & LastRow).Copy Sheets("Sheet2").Cells(2, foundDate.Column)


Thanks.

 

[mumps]

This macro will paste only the values. Do you have two sheets named "Sheet1" and "Sheet2"? Have you formatted the cells that contain dates as a date in the format "yyyy-mm-dd"?

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim strdate As String
    strdate = Sheets("Sheet1").Range("B1")
    Dim foundDate As Range
    Set foundDate = Sheets("Sheet2").Rows(1).Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        Sheets("Sheet1").Range("B2:B" & LastRow).Copy
        Sheets("Sheet2").Cells(2, foundDate.Column).PasteSpecial xlPasteValues
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[Knight_777]

This macro will paste only the values. Do you have two sheets named "Sheet1" and "Sheet2"? Have you formatted the cells that contain dates as a date in the format "yyyy-mm-dd"?

Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim strdate As String
    strdate = Sheets("Sheet1").Range("B1")
    Dim foundDate As Range
    Set foundDate = Sheets("Sheet2").Rows(1).Find(CDate(strdate), LookIn:=xlFormulas, lookat:=xlWhole)
    If Not foundDate Is Nothing Then
        Sheets("Sheet1").Range("B2:B" & LastRow).Copy
        Sheets("Sheet2").Cells(2, foundDate.Column).PasteSpecial xlPasteValues
    End If
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Hi, Thank you for the reply and sorry for being late in getting back to you.
Yes, I have used the format for the dates in both sheets.

Is there way I can share my spreadsheet with you, so you will see how the tables look like. Because I think I over simplified the file in my original post.

Thank you

 

[mumps]

Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.

 

[Knight_777]

Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.

Hi,
I have uploaded the file into dropbox and here is the link.

https://www.dropbox.com/s/qm57n1lec33n3b2/Daily Cash-Flow Template_Test.xlsm?dl=0


Thank you in advance

 

[mumps]

Will the number of Items Affecting Availability (CIBC) always be the same (currently there are 5)? Will the number of Accounts always be the same (currently there are 11)? Will the number of Receipts from Other Sources always be the same (currently there are 6)?

 

[Knight_777]

Will the number of Items Affecting Availability (CIBC) always be the same (currently there are 5)? Will the number of Accounts always be the same (currently there are 11)? Will the number of Receipts from Other Sources always be the same (currently there are 6)?

Yes there should be no change. However, I've kept one blank line just in case for Items Affecting Availability (CIBC) and for Receipts from Other Sources, and it's in both sheets

Thanks