VBA Coding - Excel keeps crashing

[rahulsteel]

I have the below VBA coding on 3 of my sheets in an excel workbook. My excel crases after few minutes, can someone suggest if there is anything wrong with the coding

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  With Sheet1.DTPicker1
  DTPicker1.Value = Format(DTPicker1.Value, "mm/dd/yyyy")
    .Height = 20
    .Width = 20
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
      .Visible = True
      .Top = Target.Top
      .Left = Target.Offset(0, 1).Left
      .LinkedCell = Target.Address
    Else
      .Visible = False
    End If
  End With
      
End Sub


Private Sub Worksheet_BeforeDoubleClick _
  (ByVal Target As Range, _
    Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet

Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
  'clear and hide the combo box
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    'if the cell contains
      'a data validation list
    Cancel = True
    Application.EnableEvents = False
    'get the data validation formula
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      'show the combobox with the list
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 5
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.Tempcombo.DropDown
  End If
  
errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub

 

[mdmilner]

General suggestion, debugging.

Add better error handling that provides more specific information. You want at least err.number, err.description and which module it occurred in (generally, but still helpful since you have 2 procedures).
Insert a code break down inside the error handler to pause code execution.
When it hits the break, start stepping through the code line by line (use resume next to make the code return to the next line so you can figure out which specific line crashed it).

Mike

 

[DanteAmor]

I made some adjustments to your code, and I have no problems.
Try and tell me.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Target.Value = "" Then Exit Sub
        If Not IsDate(Target.Value) Then Exit Sub
        With Sheet1.DTPicker1
            .Value = Format(.Value, "mm/dd/yyyy")
            .Height = 20
            .Width = 20
            .Visible = True
            .Top = Target.Top
            .Left = Target.Offset(0, 1).Left
            .LinkedCell = Target.Address
        End With
    End If
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim str As String, r As Range
    Set r = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
    If Intersect(Target, r) Is Nothing Then Exit Sub
    If Target.Validation.Type = 3 Then
        Cancel = True
        str = Target.Validation.Formula1
        str = Right(str, Len(str) - 1)
        With TempCombo
            'show the combobox with the list
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = str
            .LinkedCell = Target.Address
            .Activate
            .DropDown
        End With
    End If
End Sub

 

[rahulsteel]

I made some adjustments to your code, and I have no problems.
Try and tell me.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Target.Value = "" Then Exit Sub
        If Not IsDate(Target.Value) Then Exit Sub
        With Sheet1.DTPicker1
            .Value = Format(.Value, "mm/dd/yyyy")
            .Height = 20
            .Width = 20
            .Visible = True
            .Top = Target.Top
            .Left = Target.Offset(0, 1).Left
            .LinkedCell = Target.Address
        End With
    End If
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim str As String, r As Range
    Set r = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
    If Intersect(Target, r) Is Nothing Then Exit Sub
    If Target.Validation.Type = 3 Then
        Cancel = True
        str = Target.Validation.Formula1
        str = Right(str, Len(str) - 1)
        With TempCombo
            'show the combobox with the list
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = str
            .LinkedCell = Target.Address
            .Activate
            .DropDown
        End With
    End If
End Sub

Thank you so much, will try this

 

[DanteAmor]

Thank you so much, will try this

Okay, let me know any questions

 

[rahulsteel]

Okay, let me know any questions

I tried your codes, however, when i try to put dates on new cell (where DTpicker is enabled) it does not take the date value. For the existing cells where dates are already there, I'm able to change the dates.

 

[DanteAmor]

I tried your codes, however, when i try to put dates on new cell (where DTpicker is enabled) it does not take the date value. For the existing cells where dates are already there, I'm able to change the dates.

I only fixed your code.
Better explain what you need.
Forget the code a bit and explain what you need.


Also explains why you want a dtpicker and a dropdownlist in the same cell, with a single control should be enough.

 

[rahulsteel]

I only fixed your code.
Better explain what you need.
Forget the code a bit and explain what you need.


Also explains why you want a dtpicker and a dropdownlist in the same cell, with a single control should be enough.

Datepicker is for all cells in Column B (except B1) and drop down is in Column C,D & E

 

[DanteAmor]

Datepicker is for all cells in Column B (except B1) and drop down is in Column C,D & E

For the dtpicker:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        'If Target.Value = "" Then Exit Sub
        'If Not IsDate(Target.Value) Then Exit Sub
        On Error GoTo appena
        With Sheet1.DTPicker1
            .Value = Format(.Value, "mm/dd/yyyy")
            .Height = Target.Height
            .Width = Target.Width + 20
            .Visible = True
            .Top = Target.Top
            .Left = Target.Offset(0, 1).Left
            .LinkedCell = Target.Address(False, False)
        End With
    End If
appena:
    Application.EnableEvents = True
End Sub

Ok, so why do you want a validation list and a combobox in the same cell?
If you already have a validation list in a cell in column C, D or E, simply copy that validation to the rest of the cells in columns C, D and E.