Multiple worksheet change and Formula use

[Noid67]

So I have a two part question. I am struggling to understand how to incorporate multiple worksheet changes into one sheet. I have seen the examples for using IF NOT INTERSECT, but cannot correlate it to my needs. I also have a formula that I need to run in multiple rows and is the second part of the worksheet change. Below is the code I currently have for a worksheet change that works perfectly:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim DestWH As String
Dim DWHRowNum As Long
Dim dt As Date

DWHRowNum = 2
dt = Format(Date, "mm/dd/yyy")

Application.EnableEvents = False

Do Until Cells(DWHRowNum, 2).Value = ""
    Select Case Cells(DWHRowNum, 6).Value
        Case Is = "ABQ1"
            Cells(DWHRowNum, 7).Value = dt
            Cells(DWHRowNum, 8).Value = "17:00"
        Case Is = "BFI4"
            Cells(DWHRowNum, 7).Value = dt + 1
            Cells(DWHRowNum, 8).Value = "04:30"
        Case Is = "CLE2"
            Cells(DWHRowNum, 7).Value = dt
            Cells(DWHRowNum, 8).Value = "17:00"
        Case Is = "DEN3"
            Cells(DWHRowNum, 7).Value = dt
            Cells(DWHRowNum, 8).Value = "17:00"
        Case Is = "DEN4"
            Cells(DWHRowNum, 7).Value = dt + 1
            Cells(DWHRowNum, 8).Value = "04:30"
        Case Is = "GEG1"
            Cells(DWHRowNum, 7).Value = dt
            Cells(DWHRowNum, 8).Value = "17:00"
        Case Is = "LIT1"
            Cells(DWHRowNum, 7).Value = dt
            Cells(DWHRowNum, 8).Value = "17:00"
        Case Is = "ORD5"
            Cells(DWHRowNum, 7).Value = dt
            Cells(DWHRowNum, 8).Value = "17:00"
        Case Is = "ORF3"
            Cells(DWHRowNum, 7).Value = dt
            Cells(DWHRowNum, 8).Value = "17:00"
        Case Is = "PAE2"
            Cells(DWHRowNum, 7).Value = dt
            Cells(DWHRowNum, 8).Value = "17:00"
        Case Is = "PCW1"
            Cells(DWHRowNum, 7).Value = dt
            Cells(DWHRowNum, 8).Value = "17:00"
        Case Is = "PDX9"
            Cells(DWHRowNum, 7).Value = dt + 1
            Cells(DWHRowNum, 8).Value = "04:30"
        Case Is = "SLC1"
            Cells(DWHRowNum, 7).Value = dt
            Cells(DWHRowNum, 8).Value = "17:00"
        Case Is = "SMF1"
            Cells(DWHRowNum, 7).Value = dt + 1
            Cells(DWHRowNum, 8).Value = "04:30"
    End Select
    DWHRowNum = DWHRowNum + 1
Loop

Application.EnableEvents = True

End Sub

I want to include this formula that affects a different cell in the same worksheet as above, but this also needs to trigger based on a change in cell(s) N2:N28

Sub VRID_Status()
'
' VRID_Status Macro
'

    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-10]="""","""",IF(AND(RC[-4]="""",RC[-3]>RC[-10]),""Future"",""Current""))"
    Range("Q18").Select
End Sub

Any assistance is greatly appreciated.

 

[Noid67]

Ok, just saw a problem in the results. The new code has changed the date in column G to the year 2449. I cannot figure out how that is happening. But, when I put in a date ahead of that date into column N, the code is working as we hoped.

 

[mumps]

Change

dt = Format(Date, "mm/dd/yyy")

to

dt = Format(Date, "mm/dd/yyyy")

 

[Noid67]

I added Application.EnableEvents = False to just above the screenupdating and a true at the end. Went back and reinput the data in column F and all worked well.

 

[mumps]

Glad it worked out.

 

[Noid67]

so, after saving, closing, and reopening the workbook, the code no longer works. I have a feeling it has to do with the removal of the Do Until loop which used column B to find the end (Row 28). After entering data into any row of column F, the code is not triggered at all.

 

[mumps]

When you set Application.Enableevents=False, if the macro errors out without completing the Application.Enableevents=True line of code, any event macros you are using will not be triggered. Close Excel and re-start it and re- open the file.

 

[Noid67]

When you set Application.Enableevents=False, if the macro errors out without completing the Application.Enableevents=True line of code, any event macros you are using will not be triggered. Close Excel and re-start it and re- open the file.

Is there a way around that?

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Dim dt As Date, lRow As Long
    lRow = Range("B" & Rows.Count).End(xlUp).Row
    If Intersect(Target, Range("F:F,N:N")) Is Nothing Then Exit Sub
    If Target.CountLarge > 1 Then Exit Sub
    Application.EnableEvents = False
    On Error GoTo errHandler
    dt = Format(Date, "mm/dd/yyyy")
    Select Case Target.Column
        Case Is = 6
            Select Case Target.Value
                Case Is = "ABQ1"
                    Cells(Target.Row, 7).Value = dt
                    Cells(Target.Row, 8).Value = "17:00"
                Case Is = "BFI4"
                    Cells(Target.Row, 7).Value = dt + 1
                    Cells(Target.Row, 8).Value = "04:30"
                Case Is = "CLE2"
                    Cells(Target.Row, 7).Value = dt
                    Cells(Target.Row, 8).Value = "17:00"
                Case Is = "DEN3"
                    Cells(Target.Row, 7).Value = dt
                    Cells(Target.Row, 8).Value = "17:00"
                Case Is = "DEN4"
                    Cells(Target.Row, 7).Value = dt + 1
                    Cells(Target.Row, 8).Value = "04:30"
                Case Is = "GEG1"
                    Cells(Target.Row, 7).Value = dt
                    Cells(Target.Row, 8).Value = "17:00"
                Case Is = "LIT1"
                    Cells(Target.Row, 7).Value = dt
                    Cells(Target.Row, 8).Value = "17:00"
                Case Is = "ORD5"
                    Cells(Target.Row, 7).Value = dt
                    Cells(Target.Row, 8).Value = "17:00"
                Case Is = "ORF3"
                    Cells(Target.Row, 7).Value = dt
                    Cells(Target.Row, 8).Value = "17:00"
                Case Is = "PAE2"
                    Cells(Target.Row, 7).Value = dt
                    Cells(Target.Row, 8).Value = "17:00"
                Case Is = "PCW1"
                    Cells(Target.Row, 7).Value = dt
                    Cells(Target.Row, 8).Value = "17:00"
                Case Is = "PDX9"
                    Cells(Target.Row, 7).Value = dt + 1
                    Cells(Target.Row, 8).Value = "04:30"
                Case Is = "SLC1"
                    Cells(Target.Row, 7).Value = dt
                    Cells(Target.Row, 8).Value = "17:00"
                Case Is = "SMF1"
                    Cells(Target.Row, 7).Value = dt + 1
                    Cells(Target.Row, 8).Value = "04:30"
            End Select
        Case Is = 14
            If Range("G" & Target.Row) = "" Then
                Range("Q" & Target.Row) = ""
            ElseIf Range("M" & Target.Row) = "" And Range("N" & Target.Row) > Range("G" & Target.Row) Then
                Range("Q" & Target.Row) = "Future"
            Else
                Range("Q" & Target.Row) = "Current"
            End If
    End Select
Done:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub
errHandler:
    MsgBox "The following error occurred: " & Err.Description
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub