Help with another Macro

baldi

Board Regular
Joined
Sep 15, 2009
Messages
159
I start this macro with this.
Code:
answer = MsgBox(prompt:="You can only RESET ONE TIME! Do you really want to do this? ", Buttons:=vbYesNo + vbCritical, Title:="Transaction Error")
    If answer = vbYes Then
    Sheets("Sheet3").Select
    If Range("N44") + Range("Q41") = "" Then
    Exit Sub
    End If
Sheets("Sheet3").Select
    ActiveSheet.Unprotect "alexandeR"
    Range("N25:N32").Select
    Selection.Copy
    Range("N4:N11").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False

I want the macro to stop if cell N44 plus Q21 equal 0 but I cant get it right.
any and all help would be great thanks
 
Last edited by a moderator:

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
How about
Code:
   If answer = vbYes Then
      With Sheets("Sheet3")
         If .Range("N44").Value + .Range("Q21").Value = 0 Then Exit Sub
         .Unprotect "alexandeR"
         .Range("N25:N32").Copy .Range("N4:N11")
      End With
   End If
 
Upvote 0
How about
Code:
   If answer = vbYes Then
      With Sheets("Sheet3")
         If .Range("N44").Value + .Range("Q21").Value = 0 Then Exit Sub
         .Unprotect "alexandeR"
         .Range("N25:N32").Copy .Range("N4:N11")
      End With
   End If

this is the full macro. I cant get it to work. always get an error for "end with or end if"

Code:
[answer = MsgBox(prompt:="You can only RESET ONE TIME! Do you really want to do this? ", Buttons:=vbYesNo + vbCritical, Title:="Transaction Error")
    If answer = vbYes Then
    Sheets("sheet3").Select
    ActiveSheet.Unprotect "alexandeR"
    Range("N25:N32").Select
    Selection.Copy
    Range("N4:N11").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False
    Range("N36:N43").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("N4:N11").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
        SkipBlanks:=False, Transpose:=False
    Range("Q34:Q40").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("N15:N21").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
        SkipBlanks:=False, Transpose:=False
  
    Sheets("Sheet2").Select
    ActiveSheet.Unprotect "alexandeR"
    Sheets("sheet3").Select
    Range("N25:N32").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("I6:I13").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
        SkipBlanks:=False, Transpose:=False
    Sheets("sheet3").Select
    Range("N36:N43").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("F6:F13").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
        SkipBlanks:=False, Transpose:=False
    Sheets("sheet3").Select
    Range("Q34:Q40").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Range("C6:C12").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Protect "alexandeR"
    Sheets("sheet3").Select
    Range("N25:N32").Select
    Selection.ClearContents
    Range("N36:N43").Select
    Selection.ClearContents
    Range("Q34:Q40").Select
    Selection.ClearContents
    ActiveSheet.Protect "alexandeR"
    Sheets("LOG").Select
    ActiveSheet.Unprotect "alexandeR"
    Range("A6:I6").Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Protect "alexandeR"
    Sheets("MAIN").Select
    Range("B8:B14").Select
    Selection.ClearContents
    Range("E7:E14").Select
    Selection.ClearContents
    Range("H7:H14").Select
    Selection.ClearContents
    Range("B8").Select
    
     End If
    
End Sub
 
Last edited by a moderator:
Upvote 0
I must be putting the end with or end if in the wrong spot. just don't know where to put it
 
Upvote 0
Try
Code:
Sub baldi()
   Dim Ws2 As Worksheet
   
   Set Ws2 = Sheets("Sheet2")
   
   answer = MsgBox(prompt:="You can only RESET ONE TIME! Do you really want to do this? ", Buttons:=vbYesNo + vbCritical, title:="Transaction Error")
   If answer = vbNo Then Exit Sub
   With Sheets("Sheet3")
      If .Range("N44").Value + .Range("Q21").Value = 0 Then Exit Sub
      .Unprotect "alexandeR"
      .Range("N25:N32").Copy
      .Range("N4:N11").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
         False, Transpose:=False
      .Range("N36:N43").Copy
      .Range("N4:N11").PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
         SkipBlanks:=False, Transpose:=False
      .Range("Q34:Q40").Copy
      .Range("N15:N21").PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
         SkipBlanks:=False, Transpose:=False

      Ws2.Unprotect "alexandeR"
      .Range("N25:N32").Copy
      Ws2.Range("I6:I13").PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
         SkipBlanks:=False, Transpose:=False
      .Range("N36:N43").Copy
      Ws2.Range("F6:F13").PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
         SkipBlanks:=False, Transpose:=False
      .Range("Q34:Q40").Copy
      Ws2.Range("C6:C12").PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, _
         SkipBlanks:=False, Transpose:=False
      Ws2.Protect "alexandeR"
      .Range("N25:N32").ClearContents
      .Range("N36:N43").ClearContents
      .Range("Q34:Q40").ClearContents
      .Protect "alexandeR"
   End With
   With Sheets("LOG")
      .Unprotect "alexandeR"
      .Range("A6:I6").Delete shift:=xlUp
      .Protect "alexandeR"
   End With
   With Sheets("MAIN")
      .Range("B8:B14").ClearContents
      .Range("E7:E14").ClearContents
      .Range("H7:H14").ClearContents
      .Range("B8").Select
   End With
End Sub
 
Upvote 0
With / End With have to be nested in the same way as If /End if

For example:

Code:
Sub BaldiMacro()
    Dim answer As Integer
    answer = MsgBox(prompt:="You can only RESET ONE TIME! Do you really want to do this? ", Buttons:=vbYesNo + vbCritical, Title:="Transaction Error")
    If answer = vbYes Then
        With Sheets("sheet3")
            .Unprotect "alexandeR"
            .Range("N25:N32").Copy
            .Range("N4:N11").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
            .Range("N36:N43").Copy
            .Range("N4:N11").PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, SkipBlanks:=False, Transpose:=False
            .Range("Q34:Q40").Copy
            .Range("N15:N21").PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, SkipBlanks:=False, Transpose:=False
            .Range("N25:N32").Copy
        End With
        With Sheets("Sheet2")
            .Unprotect "alexandeR"
            .Range("I6:I13").PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, SkipBlanks:=False, Transpose:=False
        End With
        With Sheets("sheet3")
            .Range("N36:N43").Copy
        End With
        With Sheets("Sheet2")
            .Range("F6:F13").PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, SkipBlanks:=False, Transpose:=False
        End With
        With Sheets("sheet3")
            .Range("Q34:Q40").Copy
        End With
        With Sheets("Sheet2")
            .Range("C6:C12").PasteSpecial Paste:=xlPasteAll, Operation:=xlSubtract, SkipBlanks:=False, Transpose:=False
            .Protect "alexandeR"
        End With
        With Sheets("sheet3")
            .Range("N25:N32").ClearContents
            .Range("N36:N43").ClearContents
            .Range("Q34:Q40").ClearContents
            .Protect "alexandeR"
        End With
        With Sheets("LOG")
            .Unprotect "alexandeR"
            .Range("A6:I6").Delete shift:=xlUp
            .Protect "alexandeR"
        End With
        With Sheets("MAIN")
            .Range("B8:B14").ClearContents
            .Range("E7:E14").ClearContents
            .Range("H7:H14").ClearContents
            .Range("B8").Select
        End With
    End If
End Sub
 
Upvote 0
you rewrote the whole macro. thank you.
I will try it and let you know how it works.
 
Upvote 0
you rewrote the whole macro..

Sort of, but not really. I just cleaned it up a bit. Your code uses the 'select-do' method, which is where we all start out, mainly because that's how the macro-recorder works. This methodology selects something, then performs an action on it.

For example:
Code:
    Range("N25:N32").Select  '<- you "select" a source range
    Selection.Copy '<- you perform a copy on the selection
    Range("N4:N11").Select '<- you "select" a destination range
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _  '<- you paste to the selection
    False, Transpose:=False

But after a while you learn that it is more efficient to work on the ranges directly and skip the 'select-do' method:
Code:
     .Range("N25:N32").Copy  '<- I copy the range directly, no "selection" step
     .Range("N4:N11").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:=False, Transpose:=False '<- I paste to the destination range directly
 
Upvote 0
can you mix the 2 methods together and still have the macro work?

so now how do I add this to the macro.

if the SUM(N44,Q21)=0 on sheet3. the macro stops.
 
Upvote 0
Did you try my suggestion from post#5?
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top