stopping auto updateing of cells

[SRussell]

I have a sheet to calculate points scoring for an incentive I'm running for my staff. (sample sheet has been attached)

I have coded a macro to copy certain cells when it comes to the end of a week so that we can start with fresh figures, but also keep a running total.

If you look at the sample sheet, column X contains the score for the current week, column Y is the previous weeks score and column Z is the running total.

When I run the macro the sum of X & Y is pasted into Z and columns D to U (which contain the point calculations) are cleared which obviously means the value in X is now blank.

This is also reducing the value in Z because the sum X+Y is auto updating.
How can I stop this from happening?

The code I'm currently using is below

Sub newweek()
'
' newweek Macro
'

'
    Range("Z6").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z7").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z8").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z9").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z10").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z11").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z12").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z13").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z14").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z15").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z16").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z20").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z21").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z22").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z23").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z24").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z25").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("Z26").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-2]+RC[-1])"
    Range("X6:X16").Select
    Selection.Copy
    Range("Y6:Y16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("X20:X26").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("Y20:Y26").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("E6:E17").Select
    Selection.ClearContents
    Range("G6:G17").Select
    Selection.ClearContents
    Range("I6:I17").Select
    Selection.ClearContents
    Range("K6:K17").Select
    Selection.ClearContents
    Range("M6:M17").Select
    Selection.ClearContents
    Range("O6:O17").Select
    Selection.ClearContents
    Range("Q6:Q17").Select
    Selection.ClearContents
    Range("S6:S17").Select
    Selection.ClearContents
    Range("U6:U17").Select
    Selection.ClearContents
    Range("E20:E26").Select
    Selection.ClearContents
    Range("G20:G26").Select
    Selection.ClearContents
    Range("I20:I26").Select
    Selection.ClearContents
    Range("K20:K26").Select
    Selection.ClearContents
    Range("M20:M26").Select
    Selection.ClearContents
    Range("O20:O26").Select
    Selection.ClearContents
    Range("Q20:Q26").Select
    Selection.ClearContents
    Range("S20:S26").Select
    Selection.ClearContents
    Range("U20:U26").Select
    Selection.ClearContents
    Range("C6:C16").Select
    Selection.ClearContents
    Range("C20:C26").Select
    Selection.ClearContents
End Sub

Thanks for any help given.

[BaLLZaCH]

What I do in those cases is use the first part of the macro to dump X1 and Y1 into a new cell, then do all your VB calcualtions from the x2 y2 cells, not the original ones.


Its the most simple way I have thought of at least.

[davesexcel]

Hi,
Give this a try,

Sub Button3_Click()
    Dim r As Range
    Dim c As Range
    Dim z As Range
    Dim g As Range

    Set r = Range("X6", Range("X16"))

    r.Copy
    Range("Y6:Y16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                          :=False, Transpose:=False
    Application.CutCopyMode = False

    For Each c In r.Cells
        c.FormulaR1C1 = "=IF(RC[-21]=0,0,SUM(RC[-2],RC[-4],RC[-6],RC[-8],RC[-10],RC[-12],RC[-14],RC[-16],RC[-18])/RC[-21])"
    Next c
    Set z = Range("Z6", Range("Z16"))
    For Each g In z.Cells
        g = g + g.Offset(0, -1)
    Next g
    Range("E6:E16,G6:G16,I6:I16,K6:K16,M6:M16,O6:O16,Q6:Q16,S6:S16,U6:U16").ClearContents

End Sub

[SRussell]

Hi Dave,

unfortunately your code isn't working.
It copies X accross into Y but then Z reverts back to the new value in Y and the code

IF(RC[-21]=0,0,SUM(RC[-2],RC[-4],RC[-6],RC[-8],RC[-10],RC[-12],RC[-14],RC[-16],RC[-18])/RC[-21])"

is pasted into X

Unfortunately I don't know what you're code is doing so I have no idea what the problem is.

Are you able to help further?

Hi,
Give this a try,

Sub Button3_Click()
    Dim r As Range
    Dim c As Range
    Dim z As Range
    Dim g As Range

    Set r = Range("X6", Range("X16"))

    r.Copy
    Range("Y6:Y16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                          :=False, Transpose:=False
    Application.CutCopyMode = False

    For Each c In r.Cells
        c.FormulaR1C1 = "=IF(RC[-21]=0,0,SUM(RC[-2],RC[-4],RC[-6],RC[-8],RC[-10],RC[-12],RC[-14],RC[-16],RC[-18])/RC[-21])"
    Next c
    Set z = Range("Z6", Range("Z16"))
    For Each g In z.Cells
        g = g + g.Offset(0, -1)
    Next g
    Range("E6:E16,G6:G16,I6:I16,K6:K16,M6:M16,O6:O16,Q6:Q16,S6:S16,U6:U16").ClearContents

End Sub

[davesexcel]

Hi Dave,

unfortunately your code isn't working.
It copies X accross into Y but then Z reverts back to the new value in Y and the code

IF(RC[-21]=0,0,SUM(RC[-2],RC[-4],RC[-6],RC[-8],RC[-10],RC[-12],RC[-14],RC[-16],RC[-18])/RC[-21])"

is pasted into X

Unfortunately I don't know what you're code is doing so I have no idea what the problem is.

Are you able to help further?

Did you look at the formula in column x after you ran the macro??
you can't run the macro again until you have data in the appropriate cells, or you will just be transferring zero values to the next column.

[Richard Buttrey]

Whoa!,

Whenever you see repetitive code like that you can be almost certain that it can be simplified considerably. It looks like it's been recorded with the macro recorder, which is great for starting off with, but in the majority of cases it should only be a starting point. Almost invariably it should be modified and edited.

Replace it with the much simpler code below.

Sub NewWeek_v2()
Worksheets("CountSheets").Activate
Range("X6:x16").Copy: Range("Y6").PasteSpecial (xlPasteValues)
Range("X20:X26").Copy: Range("Y20").PasteSpecial (xlPasteValues)
Range("E6:U16").ClearContents: Range("E20:U26").ClearContents
End Sub

HTH

[SRussell]

Whoa!,

Whenever you see repetitive code like that you can be almost certain that it can be simplified considerably. It looks like it's been recorded with the macro recorder, ....

HTH

Hey Richard, you guessed right.

My understanding of vba is soooo basic, but you're right the macro recorder does the job until I learn more about coding.

Thanks for the code.