Hallo,
Hoe kan ik deze codes het beste samenvoegen? ik heb al wat informatie gevonden over intersect e.d. of Case opties maar kom er niet echt uit. De oplossing met Range en Range2 is ook niet helemaal zoals het hoort maar heb ik wel werkend gekregen. Hoe kan ik deze set samen werkend krijgen?
Hoe kan ik deze codes het beste samenvoegen? ik heb al wat informatie gevonden over intersect e.d. of Case opties maar kom er niet echt uit. De oplossing met Range en Range2 is ook niet helemaal zoals het hoort maar heb ik wel werkend gekregen. Hoe kan ik deze set samen werkend krijgen?
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
Dim cel As Range, targ As Range
If Target.Cells.Count > 1 Then Exit Sub
Set targ = Range("Kamers") 'Watch these cells for user selections
Set targ = Intersect(targ, Target)
If targ Is Nothing Then Exit Sub
ActionForm.Show
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myrange As Range
Set myrange = Range("VenU")
If Not Intersect(myrange, Target) Is Nothing Then
If ActiveCell.Value = "" Then
ActiveCell.Value = "a"
ActiveCell.Offset(0, 1).Select
Else:
ActiveCell.ClearContents
ActiveCell.Offset(0, 1).Select
End If
End If
Dim myrange2 As Range
Set myrange2 = Range("OpDat")
If Not Intersect(myrange2, Target) Is Nothing Then
If ActiveCell.Value = "" Then
ActiveCell.Value = Date
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' Developed by Contextures Inc.
' www.contextures.com
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 24 Then
If oldVal = "" Then
Else
If newVal = "" Then
Else
lUsed = InStr(1, oldVal, newVal)
If lUsed > 0 Then
If Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
Else
Target.Value = Replace(oldVal, newVal & ", ", "")
End If
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' Developed by Contextures Inc.
' www.contextures.com
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 25 Then
If oldVal = "" Then
Else
If newVal = "" Then
Else
lUsed = InStr(1, oldVal, newVal)
If lUsed > 0 Then
If Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
Else
Target.Value = Replace(oldVal, newVal & ", ", "")
End If
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub