aab
aab

Reputation: 1739

Excel VBA change format AFTER pasting

I've got a vba code that copies data from one sheet into another. I want to change the format AFTER pasting but it get an object required error. This is my code:

recordSht.Cells(1, lCol + 1).PasteSpecial.NumberFormat = "mm/dd/yyyy"

How can I fix this?

Here's the rest of the code:

Sub Daily()
    Dim dailySht As Worksheet 'worksheet storing latest store activity
    Dim recordSht As Worksheet 'worksheet to store the highest period of each day
    Dim lColDaily As Integer ' Last column of data in the store activity sheet
    Dim lCol As Integer ' Last column of data in the record sheet
    Dim maxCustomerRng As Range ' Cell containing the highest number of customers
    Dim CheckForDups As Range ' Used to find duplicate dates on the record Sheet
    Dim maxCustomerCnt As Double ' value of highest customer count



Set dailySht = ThisWorkbook.Sheets("Sheet A")
Set recordSht = ThisWorkbook.Sheets("Sheet B")
With recordSht
    lCol = .Cells(1, .Columns.Count).End(xlToLeft).column
End With
With dailySht
    lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).column
    maxCustomerCnt = Round(Application.Max(.Range(.Cells(14, 1), .Cells(14, lColDaily))), 2)
    Set maxCustomerRng = .Range(.Cells(14, 1), .Cells(14, lColDaily)).Find(What:=maxCustomerCnt, LookIn:=xlValues)
    If Not maxCustomerRng Is Nothing Then
    ' Check the Record Sheet to ensure the data is not already there
        Set CheckForDups = recordSht.Range(recordSht.Cells(14, 1), recordSht.Cells(14, lCol)).Find(What:=Round(maxCustomerRng.Value, 2), LookIn:=xlValues)
    ' If CheckForDups is Nothing then the date was not found on the record sheet. Therefore, copy the column
        If CheckForDups Is Nothing Then
            Range(.Cells(14, maxCustomerRng.column), .Cells(17, maxCustomerRng.column)).Copy
            recordSht.Cells(14, lCol + 1).PasteSpecial xlPasteValues
            recordSht.Cells(14, lCol + 1).PasteSpecial xlPasteFormats

            .Cells(3, maxCustomerRng.column).Copy
            recordSht.Cells(3, lCol + 1).PasteSpecial xlPasteValues
            recordSht.Cells(3, lCol + 1).PasteSpecial xlPasteFormats

            .Cells(9, maxCustomerRng.column).Copy
            recordSht.Cells(9, lCol + 1).PasteSpecial xlPasteValues
            recordSht.Cells(9, lCol + 1).PasteSpecial xlPasteFormats

            .Cells(1, maxCustomerRng.column).Copy
            recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteValues
            recordSht.Cells(1, lCol + 1).PasteSpecial.NumberFormat = "mm/dd/yyyy"
        End If
    End If
End With

 Set maxCustomerRng = Nothing
    Set dailySht = Nothing
    Set recordSht = Nothing
End Sub

Sub Daily3G()
    Dim dailySht As Worksheet 'worksheet storing latest store activity
    Dim recordSht As Worksheet 'worksheet to store the highest period of each day
    Dim lColDaily As Integer ' Last column of data in the store activity sheet
    Dim lCol As Integer ' Last column of data in the record sheet
    Dim maxCustomerRng As Range ' Cell containing the highest number of customers
    Dim CheckForDups As Range ' Used to find duplicate dates on the record Sheet
    Dim maxCustomerCnt As Double ' value of highest customer count



Set dailySht = ThisWorkbook.Sheets("3G")
Set recordSht = ThisWorkbook.Sheets("Daily 3G Busy Hour")
With recordSht
    lCol = .Cells(1, .Columns.Count).End(xlToLeft).column
End With
With dailySht
    lColDaily = .Cells(1, .Columns.Count).End(xlToLeft).column
    maxCustomerCnt = Round(Application.Max(.Range(.Cells(14, 1), .Cells(14, lColDaily))), 2)
    Set maxCustomerRng = .Range(.Cells(14, 1), .Cells(14, lColDaily)).Find(What:=maxCustomerCnt, LookIn:=xlValues)
    If Not maxCustomerRng Is Nothing Then
    ' Check the Record Sheet to ensure the data is not already there
        Set CheckForDups = recordSht.Range(recordSht.Cells(14, 1), recordSht.Cells(14, lCol)).Find(What:=Round(maxCustomerRng.Value, 2), LookIn:=xlValues)
    ' If CheckForDups is Nothing then the date was not found on the record sheet. Therefore, copy the column
        If CheckForDups Is Nothing Then
            Range(.Cells(14, maxCustomerRng.column), .Cells(17, maxCustomerRng.column)).Copy
            recordSht.Cells(14, lCol + 1).PasteSpecial xlPasteValues
            recordSht.Cells(14, lCol + 1).PasteSpecial xlPasteFormats

            .Cells(3, maxCustomerRng.column).Copy
            recordSht.Cells(3, lCol + 1).PasteSpecial xlPasteValues
            recordSht.Cells(3, lCol + 1).PasteSpecial xlPasteFormats

            .Cells(9, maxCustomerRng.column).Copy
            recordSht.Cells(9, lCol + 1).PasteSpecial xlPasteValues
            recordSht.Cells(9, lCol + 1).PasteSpecial xlPasteFormats

            .Cells(1, maxCustomerRng.column).Copy
            recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteValues
            recordSht.Cells(1, lCol + 1).PasteSpecial.NumberFormat = "mm/dd/yyyy"



        End If
    End If
End With

 Set maxCustomerRng = Nothing
    Set dailySht = Nothing
    Set recordSht = Nothing
End Sub

Upvotes: 0

Views: 1393

Answers (1)

n8.
n8.

Reputation: 1738

NumberFormat isn't something you paste, I don't think. EDIT maybe just take the "time" component out. So instead of:

.Cells(1, maxCustomerRng.column).Copy
recordSht.Cells(1, lCol + 1).PasteSpecial xlPasteValues
recordSht.Cells(1, lCol + 1).PasteSpecial.NumberFormat = "mm/dd/yyyy"

Try this:

recordSht.Cells(1, lCol + 1) = DateValue(.Cells(1, maxCustomerRng.column))

If the formatting isn't what you want you can then apply:

recordSht.Cells(1, lCol + 1).NumberFormat = "mm/dd/yyyy"

Upvotes: 2

Related Questions