Update code to copy paste values (no formulas)

Question

How could I update below code to copy paste to new sheet "day_week"in values? Asking because is giving error when the cell is in a formula, so i would like to transform the cell content to value.

Sub dayweek()

    Dim i As Integer
    Dim Ws As Worksheet, cs As Worksheet

    Set Ws = Sheets("Incidents_data")
    Ws.Select

    Ws.Range("r2", Ws.Range("r2").End(xlDown)).Select     'Update for different data column
    Selection.Copy


    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Day_week"               'Update for different data column
    Set cs = Sheets("Day_week")                 'Update for different data column

    cs.Range("A2").Select
    cs.Paste
    Application.CutCopyMode = False
    cs.Range("A2", cs.Range("A2").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    cs.Range("A1") = Ws.Range("r1").Value          'Update for different data column (only ws.Range("A1").Value) (this is just the column heading)
    cs.Range("B1") = "Number of occurrences"

    For i = 1 To cs.Range("A2", cs.Range("A2").End(xlDown)).Rows.Count
        cs.Cells(1 + i, 2) = Application.CountIf(Ws.Range("r2", Ws.Range("r2").End(xlDown)), cs.Cells(1 + i, 1))          'Update for different data column
    Next i

    cs.Range(cs.Cells(2, 1), cs.Cells(cs.Range("A2").End(xlDown).Row, 2)).Sort Key1:=cs.Range("B1"), order1:=xlDescending, Header:=xlNo

End Sub

score 0 · Accepted Answer · answered Nov 18 '15 at 12:49

Change your code like below. Comments in the code.

Sub dayweek()

    Dim i As Integer
    Dim data As Variant
    Dim destinationRange As Range
    Dim Ws As Worksheet, cs As Worksheet

    Set Ws = Sheets("Incidents_data")

    'This is redundant. You don't need to activate worksheet
    'in order to get data from it.
    'Ws.Select

    'Since you said you need only values (without formulas nor
    'formatting), instead of copying cells, we copy only their content.
    data = Ws.Range("r2", Ws.Range("r2").End(xlDown))

    'Ws.Range("r2", Ws.Range("r2").End(xlDown)).Select     'Update for different data column
    'Selection.Copy



    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Day_week"               'Update for different data column
    Set cs = Sheets("Day_week")                 'Update for different data column


    'Again, you don't need to activate worksheet to paste data in it.
    'cs.Range("A2").Select
    'cs.Paste
    Set destinationRange = cs.Range("A2").Resize(UBound(data, 1), UBound(data, 2))
    destinationRange = data


    Application.CutCopyMode = False
    cs.Range("A2", cs.Range("A2").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    cs.Range("A1") = Ws.Range("r1").Value          'Update for different data column (only ws.Range("A1").Value) (this is just the column heading)
    cs.Range("B1") = "Number of occurrences"

    For i = 1 To cs.Range("A2", cs.Range("A2").End(xlDown)).Rows.Count
        cs.Cells(1 + i, 2) = Application.CountIf(Ws.Range("r2", Ws.Range("r2").End(xlDown)), cs.Cells(1 + i, 1))          'Update for different data column
    Next i

    cs.Range(cs.Cells(2, 1), cs.Cells(cs.Range("A2").End(xlDown).Row, 2)).Sort Key1:=cs.Range("B1"), order1:=xlDescending, Header:=xlNo

End Sub

score 0 · Answer 2 · edited May 23 '17 at 12:23

I'm not sure just how important bringing across the formatting to the new worksheet is but a direct value transfer is a much more efficient method as opposed to a Copy, Paste Special Values.

I've reduced your code's reliance on .Select and ActiveSheet, preferring instead to rely on the assigned worksheet variables and the parent worksheet reference of a With ... End With statement.

Sub dayweek()

    Dim i As Long, csName As String
    Dim Ws As Worksheet, cs As Worksheet

    csName = "Day_week"  '<~~ 'Update for different data column IN ONE PLACE
    With Sheets.Add(After:=Sheets(Sheets.Count))
        .Name = csName
    End With
    Set cs = Sheets(csName)

    Set Ws = Sheets("Incidents_data")

    With Ws
        With .Range("r2", .Range("r2").End(xlDown))      'Update for different data column
            cs.Range("A2").Resize(.Rows.Count, .Columns.Count) = .Value
        End With
    End With

    With cs
        .Range("A1:B1") = Array(Ws.Range("A1").Value, "Number of occurrences")
        With .Range("A2", .Range("A2").End(xlDown))
            .RemoveDuplicates Columns:=1, Header:=xlNo
        End With
        'restate this as it may have changed rows
        With .Range("A2", .Range("A2").End(xlDown))
            .Offset(0, 1).Formula = "=COUNTIF(A:A, A2)"
            .Value = .Value
        End With
        With .Range("A1").CurrentRegion
            .Cells.Sort Key1:=.Columns(2), Order1:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
        End With
    End With


End Sub

If the formatting was mission-critical, a subsequent Copy, Paste Special Formats operation could be made.

_{See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.}

Update code to copy paste values (no formulas)

2 Answers2