Run VBA only in specific range else msg box

[Mehmud Khan]

Dear Ninjas and Excel Gurus,

Good day!

Need help in excel VBA script.

I know its bit difficult for me to crack but for Ninja's its like soooooop task....

I have created a VBA wherein user can select any cell and click on button to get time stamp on selected cell.

>>> use code - tags <<<

Sub TimeStamp()

Application.ScreenUpdating = False
  
Dim AnswerYes As String
Dim AnswerNo As String

AnswerYes = MsgBox("Are you sure want to update the time in current cell?", vbQuestion + vbYesNo, "Attention!! This command can't be undo")
If AnswerYes = vbYes Then

    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "=NOW()"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-en-US]h:mm AM/PM;@"
    
If AnswerNo = vbNo Then Exit Sub
   
End If
End If
  
Application.ScreenUpdating = False
    
End Sub

But I trying to make a change but unfortunately I failed in many attempts.

I want the above VBA should work only specific range("A5:A10") and range("B5:B10").
For more clarification, if user select cell A6 and hit on time-stamp button then user must get time get [which is working fine], but when user click on cell A11 or B15 then above VBA should not work and user get msg prompt "You are trying to stamp in wrong cell".


I hope I tried my best to explain the scenario.

If any one has any clue or suggestion then please help me out.

Thanks in advance.
regards,
Mehmud Khan

 

[rollis13]

Added some code for you (and fixed some other):

Option Explicit
Sub TimeStamp()
    Application.ScreenUpdating = False
    Dim AnswerYes As String
    'Dim AnswerNo As String
    '---added---
    If Intersect(ActiveCell, Range("A5:B10")) Is Nothing Then
        MsgBox "You are trying to stamp in wrong cell."
        Exit Sub
    End If
    '-----------
    AnswerYes = MsgBox("Are you sure want to update the time in current cell?", vbQuestion + vbYesNo, "Attention!! This command can't be undo")
    If AnswerYes = vbYes Then
        ActiveCell.Select
        ActiveCell.FormulaR1C1 = "=NOW()"
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Selection.NumberFormat = "[$-en-US]h:mm AM/PM;@"
        'If AnswerNo = vbNo Then Exit Sub          '<- not necessary
    End If
    Application.ScreenUpdating = True             '<- fixed (was = False)
End Sub

But you can cut it down to:

Option Explicit
Sub TimeStamp()
    Dim AnswerYes As String
    Application.ScreenUpdating = False
    If Intersect(ActiveCell, Range("A5:B10")) Is Nothing Then
        MsgBox "You are trying to stamp in wrong cell."
        Exit Sub
    End If
    AnswerYes = MsgBox("Are you sure want to update the time in current cell?", vbQuestion + vbYesNo, "Attention!! This command can't be undo")
    If AnswerYes = vbYes Then ActiveCell = Format(Now, "[$-en-US]h:mm AM/PM;@")
    Application.ScreenUpdating = True
End Sub

 

[Mehmud Khan]

Dear rollis,

You are not just fabulous, you are awesome...

everything worked perfect as I was expected.

Thank you so much for your codes...

If you get the time so you can shorten to below code, please; (as you did above)

Sub TimeStamp()

Application.ScreenUpdating = False

    Dim AnswerYes As String

    If Intersect(ActiveCell, Range("F10:F40,K10:K40,S10:S40,X10:X40,AE10:AE40,AJ10:AJ40,AQ10:AQ40,AV10:AV40")) Is Nothing Then
        MsgBox "Incorrect cell selected !!! Please stamp only in yellow highlighted cells."
        Exit Sub
    End If

If ActiveCell.Value = "" Then

ActiveSheet.Unprotect "@123@"

On Error Resume Next
 
Dim AnswerNo As String

AnswerYes = MsgBox("Are you sure want to update the time in current cell?", vbQuestion + vbYesNo, "Attention!! This command can't be undo")
If AnswerYes = vbYes Then

  If ActiveSheet.Range("E10").Value = "" Then Exit Sub
 
 
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "=NOW()"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-en-US]h:mm AM/PM;@"
    
    ActiveCell.Select
    Selection.Offset(0, 1).Select
    ActiveSheet.Unprotect "TCSLGBS@2014"
    Selection.Cells(1, 1).Value = Environ("Username")
    ActiveCell.Select
    Selection.Offset(0, 2).Select
    
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "=GetTimeZoneAtPresent()"
    ActiveCell.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        ActiveCell.Select
    Selection.Offset(0, 2).Select


ActiveSheet.Protect "@123@"
    
ActiveWorkbook.Save

If AnswerNo = vbNo Then Exit Sub

ActiveSheet.Protect "@123@"
  
End If
End If
 
Application.ScreenUpdating = True
ActiveSheet.Protect "@123@"
ActiveWorkbook.Save

End Sub

 

[rollis13]

No, this is a completely different request from the subject of this thread. You can do it yourself as an exercise; the logic is the same as in the previous macro I updated. No need to use all those ".Select / Selection", just go straight to the cell and fill it as needed and without using ".FormulaR1C1" and then "PasteSpecial Paste:=xlPasteValues" to convert the formula to value.
By the way, since you're working on an active sheet, how come you're using two different passwords for the .Unprotect ? I think you're not noticing the issue just because you're using "On Error Resume Next". While debugging the macro disable the line of code and you'll notice that the macro, when used, throws a specific error.
Anyway, glad having been of some help.

 

[Mehmud Khan]

Hi rollis...

Thanks a lot for your support...

Sure, I'll do as an exercise...

regards,
Mehmud