none
Double Click Options.... RRS feed

  • Question

  • Dear Group I ran My head into some Big Wall Again...

    Ive got this Working Code

    Private Sub Workbook_sheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
        Select Case Sh.Name
            Case "ThisSheet", "ThatSheet"
                ' Skip these sheets
            Case Else
                If Not Intersect(Sh.Range("D11:D14"), Target) Is Nothing Then
                    Cancel = True
                    Sh.Range("P48").Value = Target.Value
                ElseIf Not Intersect(Sh.Range("D15:D18"), Target) Is Nothing Then
                    Cancel = True
                    Sh.Range("P49").Value = Target.Value
                End If
               
                If Not Intersect(Target, Range("$Y$8")) Is Nothing Then 'Adjust J:J as needed
        Cancel = True
       
        Target.Value = Time
        Target.Offset(0, 0).Value = Now 'Change Now to Time if you only want the time and no date
    End If
        End Select
    End Sub

    When User doubel click on those Preset Range. it Works Just Fine
    i hat a change to that code so now i need a Extra Option

    Option 1 where i set double click on Range D11:D14 is ok take name NeXT to that range ther was double click on copy and past it into preset range as P48

    Option 2 where i set double click on Range D15:D18 is ok take name NeXT to that range ther was double click on copy and past it into preset range as P49

    Option 3 Where i set double click on range $Y$8 Works Fine too. Set the actually Time when Double CLick

    i have try to set new options 4 into it but it wont work

    option 4 should call a new Macro (Change date in sheet(Kampnr))

    I Cant figure out what and when or wich change i hat to do

    The Code for Change Date is below this line And this code Works ALso Ok in a Modul

    --------------------------------------------------------

    Sub SkiftKampDato()
    With ActiveSheet
     mynum = Application.InputBox("Please enter the number!", Type:=1)
     newdate = Application.InputBox("Please enter the new date!", Type:=2)

    Dim targetCell As Range
     Set targetCell = Worksheets("Kampnr").Range("B:B").Find(mynum)
     'Worksheets("Kampnr").Unprotect Password:="Dart"
     If Not targetCell Is Nothing Then
         targetCell.Offset(0, 1).Value = newdate
     'Worksheets("Kampnr").Protect Password:="Dart"
     End If
     End With
     End Sub

    Hope That was Enough Hint's for Now

    From Henrik-1 Denmark

    Monday, December 8, 2014 10:02 PM

Answers

  • When User doubel click on those Preset Range. it Works Just Fine
    i hat a change to that code so now i need a Extra Option

    Option 1 where i set double click on Range D11:D14 is ok take name NeXT to that range ther was double click on copy and past it into preset range as P48

    Option 2 where i set double click on Range D15:D18 is ok take name NeXT to that range ther was double click on copy and past it into preset range as P49

    Option 3 Where i set double click on range $Y$8 Works Fine too. Set the actually Time when Double CLick

    i have try to set new options 4 into it but it wont work

    option 4 should call a new Macro (Change date in sheet(Kampnr))

    I Cant figure out what and when or wich change i hat to do

    The Code for Change Date is below this line And this code Works ALso Ok in a Modul

    what do you mean? if the function works, just put it in the 'case else' clause.
    • Marked as answer by Henrik-1 Wednesday, December 10, 2014 11:06 PM
    Wednesday, December 10, 2014 9:21 AM
  • Sorry Caillen But it was not what i want...

    Thanks for trying to give a hint.

    Thanks to shawnzkz after trying i got it to Work as you reply me to do

    so here i the result in differnt texture.

    Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
        Select Case Sh.Name
            Case "ThisSheet", "ThatSheet"
                ' Skip these sheets
            Case Else
                If Not Intersect(Sh.Range("D11:D14"), Target) Is Nothing Then
                    Cancel = True
                    Sh.Range("P48").Value = Target.Value
                ElseIf Not Intersect(Sh.Range("D15:D18"), Target) Is Nothing Then
                    Cancel = True
                    Sh.Range("P49").Value = Target.Value
            
                ElseIf Not Intersect(Sh.Range("F6"), Target) Is Nothing Then
                    Cancel = True
                    Call SkiftKampDato
               

                End If
                If Not Intersect(Target, Range("$Y$8")) Is Nothing Then 'Adjust J:J as needed
        Cancel = True
       
        Target.Value = Time
        Target.Offset(0, 0).Value = Now 'Change Now to Time if you only want the time and no date
    End If
        End Select
    End Sub

    Your regards from Denmark.


    • Edited by Henrik-1 Wednesday, December 10, 2014 11:07 PM failor on texting
    • Marked as answer by Henrik-1 Wednesday, December 10, 2014 11:07 PM
    Wednesday, December 10, 2014 11:05 PM

All replies

  • When User doubel click on those Preset Range. it Works Just Fine
    i hat a change to that code so now i need a Extra Option

    Option 1 where i set double click on Range D11:D14 is ok take name NeXT to that range ther was double click on copy and past it into preset range as P48

    Option 2 where i set double click on Range D15:D18 is ok take name NeXT to that range ther was double click on copy and past it into preset range as P49

    Option 3 Where i set double click on range $Y$8 Works Fine too. Set the actually Time when Double CLick

    i have try to set new options 4 into it but it wont work

    option 4 should call a new Macro (Change date in sheet(Kampnr))

    I Cant figure out what and when or wich change i hat to do

    The Code for Change Date is below this line And this code Works ALso Ok in a Modul

    what do you mean? if the function works, just put it in the 'case else' clause.
    • Marked as answer by Henrik-1 Wednesday, December 10, 2014 11:06 PM
    Wednesday, December 10, 2014 9:21 AM
  • Hello Henrik,

    I tested your code and didn't figure out what you're expecting. I think you may want to modify the ShiftKampDato method and use it in your original VBA function. You can add some parameters to this function, then pass your variable values to this function. For example:

    Private Sub Workbook_sheetBeforeDoubleClick(ByVal sh As Object, ByVal Target As Range, Cancel As Boolean)
        MsgBox "OK"
        Select Case sh.Name
            Case "ThisSheet", "ThatSheet"
                ' Skip these sheets
            Case Else
                'Your other code...
                SkiftKampDato sh
        End Select
    End Sub
    
    
    Sub SkiftKampDato(ByVal sh As Worksheet)
        With ActiveSheet
            mynum = Application.InputBox("Please enter the number!", Type:=1)
            newdate = Application.InputBox("Please enter the new date!", Type:=2)
            sh.Range("P48").Value = mynum
            sh.Range("P49").Value = newdate
        End With
    End Sub


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Wednesday, December 10, 2014 9:45 AM
    Moderator
  • Sorry Caillen But it was not what i want...

    Thanks for trying to give a hint.

    Thanks to shawnzkz after trying i got it to Work as you reply me to do

    so here i the result in differnt texture.

    Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
        Select Case Sh.Name
            Case "ThisSheet", "ThatSheet"
                ' Skip these sheets
            Case Else
                If Not Intersect(Sh.Range("D11:D14"), Target) Is Nothing Then
                    Cancel = True
                    Sh.Range("P48").Value = Target.Value
                ElseIf Not Intersect(Sh.Range("D15:D18"), Target) Is Nothing Then
                    Cancel = True
                    Sh.Range("P49").Value = Target.Value
            
                ElseIf Not Intersect(Sh.Range("F6"), Target) Is Nothing Then
                    Cancel = True
                    Call SkiftKampDato
               

                End If
                If Not Intersect(Target, Range("$Y$8")) Is Nothing Then 'Adjust J:J as needed
        Cancel = True
       
        Target.Value = Time
        Target.Offset(0, 0).Value = Now 'Change Now to Time if you only want the time and no date
    End If
        End Select
    End Sub

    Your regards from Denmark.


    • Edited by Henrik-1 Wednesday, December 10, 2014 11:07 PM failor on texting
    • Marked as answer by Henrik-1 Wednesday, December 10, 2014 11:07 PM
    Wednesday, December 10, 2014 11:05 PM