VBA Coding - Excel keeps crashing

rahulsteel

New Member
Joined
Apr 3, 2019
Messages
11
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

Code:
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
 
Last edited by a moderator:

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
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
 
Upvote 0
I made some adjustments to your code, and I have no problems.
Try and tell me.

Code:
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
 
Upvote 0
I made some adjustments to your code, and I have no problems.
Try and tell me.

Code:
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
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
Datepicker is for all cells in Column B (except B1) and drop down is in Column C,D & E

For the dtpicker:
Code:
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.
 
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top