Microsoft Office Forums - View Single Post - [Solved] Macro not Performing Formula Update as Expected

charlesdh · 06-26-2014, 11:38 AM

Hi,

I modified your code. I left most of it in.
Copy and paste. Test on a copy. If it works then try it in your file.
Be sure you back up before you run on the actual data.

Code:

Sub AddADay()
'
' AddAShift Macro
'
'
Dim ws As Worksheet
Set ws = Sheets("PEUG")
lrow = ws.Range("D65536").End(xlUp).Row
    If MsgBox("Has ALL Data for Previous Shift Been Entered? If not, click 'No'.", vbYesNo) = vbNo Then Exit Sub
    ActiveSheet.Unprotect
    Rows("17:17").Copy
    Rows("17:17").Insert Shift:=xlDown
    Application.CutCopyMode = False
   Cells(17, 10).Formula = "=SUMPRODUCT(I17:I" & lrow & ",--((G17:G" & lrow & ")<31))/SUMPRODUCT(H17:H" & lrow & ",--((G17:G" & lrow & ")<31))"
   Cells(17, 17).Formula = "=SUMPRODUCT(P17:P" & lrow & ",--((N17:N" & lrow & ")<31))/SUMPRODUCT(O17:O" & lrow & ",--((N17:N" & lrow & ")<31))"
   Cells(17, 24).Formula = "=SUMPRODUCT(W17:W" & lrow & ",--((U17:U" & lrow & ")<31))/SUMPRODUCT(V17:V" & lrow & ",--((U17:U" & lrow & ")<31))"
   Cells(17, 31).Formula = "=SUMPRODUCT(AD17:AD" & lrow & ",--((AB:AB" & lrow & ")<31))/SUMPRODUCT(AC17:AC" & lrow & ",--((AB17:AB" & lrow & ")<31))"
   Cells(17, 38).Formula = "=SUMPRODUCT(AK17:AK" & lrow & ",--((AI17:AI" & lrow & ")<31))/SUMPRODUCT(AJ17:AJ" & lrow & ",--((AI17:AI" & lrow & ")<31))"

    Range("h17:i17").ClearContents
    Range("o17:p17").ClearContents
    Range("v17:w17").ClearContents
    Range("ac17:ad17").ClearContents
    Range("aj17:ak17").ClearContents
    Range("J18:K18").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("q18:r18").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("x18:y18").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("ae18:af18").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("al18:am18").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False
End Sub