VBA Paste Date

[stevod]

All,

Need some help with date pasting, the sheet where the data comes from is a formula and the code that pastes is this

Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

When it pastes the date it cannot be read by a formula because it isn't in Date serial.
So the below 16/2/2020 can be read by a formula and sums if they are selected.
The 17/2/2020 was pasted with the vba code and doesn't work with a formula.

Can anyone help with this one, tried numerous things to get it to work now

 

[stevod]

Right now you are talking about the target column, but regardless of its formatting your code should work and mine also, in two steps instead of one step. Did you use the F8 key to see what's happening after step one? What's the formula in the source cell to be copied and pasted?

The formula was just =N$1$... which looks at a data pasted in to the sheet with other data.

 

[GWteB]

Actually that is incorrect, if the cells were formatted as Text before the paste then the result after the paste would be text not a real date.

I was talking about the source, assuming it was formatted as Date, like stevod said. The formatting of the source overrules the text formatting of the target (with xlPasteValuesAndNumberFormats and xlPasteFormats), therefore I was surprised, like stevod, that it didn't work, so the formula had to be the cause.

The code could do with all that selecting being removed but if it isn't causing stevod any issues then it isn't a problem for this thread.

I agree on that.

 

[stevod]

stevod was answering one of my questions from post 5

Anyway stevod appears to have it solved now that the source formula has been amended (which is why I also asked to see the formula in post 5).
The code could do with all that selecting being removed but if it isn't causing stevod any issues then it isn't a problem for this thread.

Im still learning with vba. Each time i need something i learn more. All self taught though so its only going to be a basic code from me

 

[MARK858]

Only mentioned the Selections as they must be slowing your code down.
I was bored so try the code below but beware that I have done absolutely no testing so make sure that you test it on a copy of your workbook.

Sub Formulate()
    Dim LR As Long
    Dim i As Long

    Application.ScreenUpdating = False

    '##Sheet1## select pasted data with special visible cells
    With Sheets("Sheet1")
        LR = .Range("H" & Rows.Count).End(xlUp).Row
        .Range("A4:M" & LR - 1).SpecialCells(xlCellTypeVisible).Copy
    End With
    '##sheet 2## copy data down
    With Sheets("Sheet2")
        .Range("A3").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

        'copies down the empty cells in Column 1 & 2
        LR = .Cells(Rows.Count, "C").End(xlUp).Row
        For i = 2 To LR
            If .Cells(i, 1).Value = "" Then .Cells(i, 1).Value = .Cells(i - 1, 1).Value
            If .Cells(i, 2).Value = "" Then .Cells(i, 2).Value = .Cells(i - 1, 2).Value
        Next
        'copies the formulated data ready to paste into sheet 3
        LR = .Range("C" & Rows.Count).End(xlUp).Row 'this line is probably redundant, left it in just in case
        .Range("P3:U" & LR).Copy
    End With
    '##sheet3 pastes the copied data
    With Sheets("Sheet3")
        .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        'copies the formulas in the grey area to the end of the range in "F"
        .Range(.Range("G" & Rows.Count).End(xlUp), .Range("A" & Rows.Count).End(xlUp).Offset(, 6)).Resize(, 19).FillDown
    End With
     
       
    'Deletes the data and refreshes pivot table

    With Sheets("Sheet2")
        LR = .Range("C" & Rows.Count).End(xlUp).Row
        .Range("A3:K" & LR).ClearContents
    End With
    With Sheets("Sheet1")
        .Columns("A:I").ClearContents
        With .Columns("A:I")
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlTop
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True
        End With
        .Columns("A:I").UnMerge ' not sure why you are merging cells then unmerging straight away but have left it
    End With
    Sheets("Searchable").Select
    ActiveWorkbook.RefreshAll

    Application.ScreenUpdating = True

End Sub

 

[stevod]

Cheers Mark. Appreciate it, i'll test it soon