Cell substitution problem

[Agnarr]

Hello everyone.
I made an excel sheet for a work schedule. Under each day one can choose a drop down menu to choose a specific time or phrase and through vba it automatically shows the end time on the adjacent cell.
My problem is that when i delete one cell or change the time to nothing (it's an option from the drop down list), it erases everything on the row. How could i stop that from happening?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim inputR As Range, codeR As Range, cell As Range
Dim f, fnd As Range
If Intersect(Target, Range("c4:ad50")) Is Nothing Then Exit Sub
   Application.ScreenUpdating = False
 
    Set fnd = Sheets("Holidays").Range("f:f").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        Target.Offset(, 1) = fnd.Offset(, 2)
    End If
    Application.ScreenUpdating = True
Set inputR = Range("c4:ad50") 
Set codeR = Worksheets("Holidays").Range("f:f") 
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, inputR) Is Nothing Then Exit Sub
With Application
  .EnableEvents = False
   For Each cell In Target
        Set f = codeR.Find(cell.Value, , , xlWhole)
        If Not f Is Nothing Then cell.Value = f.Offset(, 1).Value
  Next
  .EnableEvents = True
End With

End Sub

 

[kevin9999]

Could you provide a copy of your sheet using the XL2BB add in, or alternatively share your workbook via Dropbox, Google Drive or similar file sharing platform?

 

[Alex Blakenburg]

Can you try adding the EnableEvent = False line after ScreenUpdating = False.

If Intersect(Target, Range("c4:ad50")) Is Nothing Then Exit Sub
   Application.ScreenUpdating = False
   Application.EnableEvents = False             ' XXX Add this line XXX

 

[Agnarr]

Could you provide a copy of your sheet using the XL2BB add in, or alternatively share your workbook via Dropbox, Google Drive or similar file sharing platform?

ΠΡΟΓΡΑΜΜΑ1.xlsm

Shared with Dropbox

www.dropbox.com

 

[Alex Blakenburg]

I'm afraid your current code doesn't make much sense.
You have the same drop down options in the Start Date Column and End Date column.
Do you want to put in the start and end date if you pick text from the drop down in either the Start OR End date column ?

 

[Alex Blakenburg]

I might have totally misunderstood your requirement but give this a try.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim f, fnd As Range, colStart As Long, colEnd As Long

If Intersect(Target, Range("c5:ad99")) Is Nothing Then Exit Sub     ' if not in data range exit sub
If WorksheetFunction.IsNumber(ActiveCell.Value) Then Exit Sub       ' if number ie time value exit sub

' Look in heading row 4 if empty then Target is in End Time column for that day
If Cells(4, Target.Column).Value = "" Then
    colStart = Target.Column - 1
Else
    colStart = Target.Column
End If

Application.ScreenUpdating = False
Application.EnableEvents = False

' if Target set to "" then set Start and End time to ""
If Target.Value = "" Then
    Cells(Target.Row, colStart).Value = ""
    Cells(Target.Row, colStart + 1).Value = ""
Else
    ' Get Values for Text
    Set fnd = Sheets("Holidays").Range("f:f").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd Is Nothing Then
        Cells(Target.Row, colStart) = fnd.Offset(, 1)
        Cells(Target.Row, colStart + 1) = fnd.Offset(, 2)
    End If
End If

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub