Combinate 2 vba codes [Closed]

Report
-
Posts
261
Registration date
Saturday April 11, 2009
Status
Member
Last seen
June 21, 2011
-
Hello,
How can I write these to codes into one code?

Code1)

Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim MyRange As Range
Dim IntersectRange As Range

Set MyRange = Range("d9:e38")

Set IntersectRange = Intersect(Target, MyRange)

On Error GoTo SkipIt

If IntersectRange Is Nothing Then
Exit Sub

Else

ActiveSheet.Unprotect
Application.ScreenUpdating = False

Target = Format(Now, "ttttt")

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xllockedCells

End If

ActiveSheet.Unprotect
Rows("1:3").Select
Range("1:3,A4:E65536").Select
Range("1:3,A4:E65536,G4:IV65536").Select
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False

ActiveCell.Offset(, 1).Select

SkipIt:
Exit Sub


End Sub


Code 2)
Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const WS_RANGE As String = "A9:A39" '<== change to suit

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target

Me.Unprotect
Target.Value = Format(Now, "ddddd")
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Me.EnableSelection = xllockedCells
Cancel = True
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

1 reply

Posts
261
Registration date
Saturday April 11, 2009
Status
Member
Last seen
June 21, 2011
307
Hi mia

Try this


Public Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Const WS_RANGE As String = "A9:A39"
    Dim MyRange As Range
    Dim IntersectRange As Range
    Set MyRange = Range("d9:e38")
    Set IntersectRange = Intersect(Target, MyRange)
    On Error GoTo SkipIt
    If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
        With Target
            Me.Unprotect
            Target.Value = Format(Now, "ddddd")
            Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
            Me.EnableSelection = xllockedCells
            Cancel = True
        End With
    Else
        If IntersectRange Is Nothing Then
            Exit Sub
        Else
            ActiveSheet.Unprotect
            Application.ScreenUpdating = False
            Target = Format(Now, "ttttt")
            ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
            ActiveSheet.EnableSelection = xllockedCells
        End If
        ActiveSheet.Unprotect
        Rows("1:3").Select
        Range("1:3,A4:E65536").Select
        Range("1:3,A4:E65536,G4:IV65536").Select
        Selection.Locked = False
        Selection.FormulaHidden = False
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False
        ActiveCell.Offset(, 1).Select
    End If
SkipIt:
    Application.EnableEvents = True
    Exit Sub
End Sub