Multiple worksheet change and Formula use

Noid67

Noid67

New Member
Joined
Feb 18, 2024
Messages
11
Office Version
  1. 365
Platform
  1. Windows
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:

VBA Code: 
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

VBA Code: 
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.
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).
 
Upvote 0
KRB9 OB Dock Management.xlsm
BCDEFGHIJKLMNOPQR
1ZoneDock DoorO/CDWHCPT DateCPT TimeTrailer IDVehicle IDVRIDSealReplacement VRIDSDT DateSDT TimeStatusVRID StatusROC Case #
2A118OPENGEG12/18/244917:00YTR91146689903V521781 11669M6DN304230396932/19/202417:00LCurrent 
3A119CLOSED  
4A120CLOSEDLOTO  
5A121OPENGEG12/18/244917:00YTR91146770098V501864 115NN1XJM304230399812/18/202417:00LCurrent 
6A122OPEN  
7B125OPENPAE22/18/244917:00YTR91146780174GV2202623 115N7VFBP304228624922/19/202417:00LCurrent 
8B126OPENBFI42/19/24494:30YTR91146325782V503667 112J3Y37K304231255902/19/20244:30LCurrent 
9B127CLOSED  
10B128OPENDEN32/18/244917:00YTR91146771040GV2200425 116S9CMTH304232187932/19/202416:03LCurrent 
11B129OPENDEN32/18/244917:00YTR91146700331W24638 11655NJMC304230398352/18/202417:00LCurrent 
12B130OPENMTO  
13B131OPENDEN32/18/244917:00YTR91146680026HV2201678 1169B43CS304231248902/17/202417:00LCurrent 
14B132OPEN  
15C133CLOSEDLOTO  
16C134OPENSLC12/18/244917:00YTR91146454393V564580 111RKZ6BM304231255892/19/202417:00LCurrent 
17C135OPENMTO  
18C136CLOSEDIN  
19C137CLOSEDIN  
20C138OPENMTOPDX92/19/24494:30YTR91146805889V512757 1129K9C8S304231263782/19/20244:20LCurrent 
21D241CLOSED  
22D242CLOSED  
23D245OPENPAE22/18/244917:00Current 
24D246CLOSED  
25E263CLOSED  
26E264CLOSED  
27E265CLOSED  
28E266CLOSED  
Dock Door Status
Cell Formulas
RangeFormula
Q2:Q28Q2=IF(G2="","",IF(AND(M2="",N2>G2),"Future","Current"))
R2:R28R2=IF(M2<>"","",IFERROR(INDEX($K$34:$K$48,MATCH($K2,$E$34:$E$48,0)),""))
Cells with Conditional Formatting
CellConditionCell FormatStop If True
Q2:Q28Cell Value="Current"textNO
Q2:Q28Cell Value="Future"textNO
I2:I28Cell ValueduplicatestextNO
D2:E28Expression=$D2="CLOSED"textNO
D2:E28Expression=$D2="OPEN"textNO
F2:P28Expression=$P2="F"textNO
F2:P28Expression=$P2="L"textNO
Cells with Data Validation
CellAllowCriteria
P2:P28List='Defined Names'!$H$3:$H$5
D2:D28List='Defined Names'!$N$3:$N$4
E2:E28List='Defined Names'!$E$2:$E$11
F2:F28List='Defined Names'!$B$2:$B$16
 
Upvote 0
Try:
VBA Code: 
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
    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
            Target.Offset(, 3).Formula = "=IF(G" & Target.Row & "="""","""",IF(AND(M" & Target.Row & "="""",N" & Target.Row & ">G" & Target.Row & "),""Future"",""Current""))"
    End Select
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Not quite what I need. The purpose is to remove the formulas from the spreadsheet. I need the second formula to run as an additional change triggered when there is a date input into cell N (any row between 2 and 28).
 
Upvote 0
You currently have formulas in columns Q and R. Are you saying that you want to remove these formulas and have the code perform those actions when a date is entered in column N?
 
Upvote 0
mumps said:
You currently have formulas in columns Q and R. Are you saying that you want to remove these formulas and have the code perform those actions when a date is entered in column N?
Click to expand...
Almost. My fault. I want to keep the formula in column R (for now). But I do want to remove the formulas in Q and trigger the code (worksheet change) when a date is entered in column N. The results for that date will trigger a conditional format for column Q.

I hope this makes sense.
 
Upvote 0
Delete the formulas in column Q and try this version:
VBA Code: 
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
    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
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Close. After removing the formulas and replacing the code, it will put "Current" in the appropriate cell, but if a future date is input into column N, "Current" is still returned.
 
Upvote 0
The result of the code also depends on what data is in columns M, N and G. Check those columns.
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
If formula
Replies
2
Views
314
Fegal
F
F
  • Question Question
Excel Formula for Dynamic Timetable with Variable Time Increments based on certain hours of the day
Replies
1
Views
664
Muhammad_Usman
Muhammad_Usman
I
  • Question Question
Accrual Worksheet Next Pay date Formula
Replies
0
Views
287
ItalianPlatinum
I
P
  • Solved
Select Case in VBA
Replies
3
Views
755
rollis13
rollis13
S
  • Question Question
Macro to change one cell on a sheet, save sheet as PDF, then loop back and change that one cell on that sheet and repeat until the end
Replies
3
Views
680
IslandofBDA
I

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

Share this page

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