Manipulating another cell when a cell changes value in VBA

user_17958690 0
Viewed 50

This is the whole thing. Like I said, they both work when only one is in there at a time. I tried placing it at the end, the beginning. Sorry, still trying to learn so I wanted to see if I could trouble shoot first. No luck.

Option Explicit


Private prevVal

 

Private Sub Worksheet_Activate()

   prevVal = ActiveCell.Value 'memorize the value of the active cell

End Sub

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   prevVal = Target.Value     'memorize the value of the selected cell

End Sub

 

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not (Application.Intersect(Range("G1:G5000"), Target) Is Nothing) Then

        If prevVal <> "" Then

            Target.Offset(, 14).Value = "No" 'do the job only if prevVal was empty...

        End If

    End If

End Sub



Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    
    
   
    
    Dim emailRng As Range, cl As Range
    Dim sTo As String
    Set emailRng = Worksheets("POC&Airport Codes&KEY").Range("D3:D4")

    If InStr(1, Target, "BPS", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D3:D5")
    ElseIf InStr(1, Target, "FRT", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D11:D15")
    ElseIf InStr(1, Target, "PG", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D64:D65")
          ElseIf InStr(1, Target, "CP", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D57")
    ElseIf InStr(1, Target, "CSC", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D37:D39")
          ElseIf InStr(1, Target, "CEN", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D28:D31")
    ElseIf InStr(1, Target, "AFI", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D69:D70")
    ElseIf InStr(1, Target, "ATLAS", vbTextCompare) > 0 Then
        Set emailRng = ThisWorkbook.Sheets("POC&Airport Codes&KEY").Range("D79:D82")
    End If
    
    For Each cl In emailRng
        sTo = sTo & " ;" & cl.Value
    Next
    
    sTo = Mid(sTo, 2)
    If Target.CountLarge > 1 Then Exit Sub
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
   
    Select Case Target.Column
        Case Is = 16
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = sTo
                .CC = "cs-requests@socosix.com"
                .Subject = Format(Range("F" & Target.Row), "#") & " " & Range("J" & Target.Row) & " " & Range("L" & Target.Row) & " " & Format(Range("A" & Target.Row), "dd-mmmm-yyyy") & " " & "CS"
                .HTMLBody = "Please see the attached transportation request and confirm service at your earliest convenience.  " & "<br>" _
                    & "Tail: " & Range("O" & Target.Row)
                .Display
                
            End With
    
    
        Case Is = 6
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = "njasecurity@netjets.com"
                .CC = "cs-requests@socosix.com; rmains@qssecurity.com"
                .Subject = "Crew Secure Ground Transport " & "/ " & Format(Range("A" & Target.Row), "mm-dd-yyyy") & " / " & Range("L" & Target.Row) & " / " & Range("O" & Target.Row)
                .HTMLBody = "Confirmation #: " & Format(Range("F" & Target.Row), "#") & "<br> " _
                    & "Date: " & Format(Range("A" & Target.Row), "mm-dd-yyyy") & "<br>" _
                    & "Time: " & Format(Range("A" & Target.Row), "hh:mm") & " L " & "<br>" _
                    & "Crew: " & Range("H" & Target.Row) & "<br>" _
                    & "<br>" _
                    & "<br>" _
                    & "Vehicle: " & Range("U" & Target.Row) & "<br>" _
                    & "Plate #: " & Range("V" & Target.Row) & "<br>" _
                    & "<br>" _
                    & "<br>" _
                    & "<br>" _
                    & "Driver: " & Range("S" & Target.Row) & "<br>" _
                    & "Cell Phone: " & "<br>" _
                    & "<br>" _
                    & "<br>" _
                    & "Should there be any issues regarding the aforementioned services, please contact our 24hr-Operations Center (614) 239-5412 or email NJASecurity@netjets.com."
                 .Display
            End With
            
        Case Is = 26
            Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = "WhatsApp Chat"
                .Subject = Format(Range("F" & Target.Row), "#")
                .HTMLBody = "Date: " & Format(Range("A" & Target.Row), "dd-mmmm-yy") & "<br>" _
                    & "Driver Arrival: " & Format(Range("D" & Target.Row), "hh:mm") & " L " & "<br>" _
                    & "PAX: " & Range("H" & Target.Row) & "<br>" _
                    & "Tail: " & Range("O" & Target.Row) & "<br>" _
                    & Range("M" & Target.Row) & " " & "to" & " " & Range("N" & Target.Row) & "<br>" _
                    & "Driver: Please assign and add to chat. "
                   .Display
            End With
    End Select
    Application.ScreenUpdating = False



End Sub

One error I got when they were both present was that it couldnt set OutApp.

vba excel automation
1 Answers

Please, copy the next code in the sheet module where to be triggered:

Option Explicit

Private prevVal

Private Sub Worksheet_Activate()
   If ActiveCell.Column = 6 Then
       prevVal = ActiveCell.value 'memorize the value of the active cell
   End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Target.Column = 6 Then
        prevVal = Target.value     'memorize the value of the selected cell
   End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not (Application.Intersect(Range("F1:F5000"), Target) Is Nothing) Then
        If prevVal <> "" Then
           Application.EnableEvents = False
            Target.Offset(, 3).value = "No" 'do the job only if prevVal was empty...
           Application.EnableEvents = True
        End If
    End If
End Sub

How it works:

  1. It needs to be initialized (to memorize the value of the active cell), so you need to go out from the sheet and come back to trigger Activate event, for the first time. After that, when sheet is activated it does its job...

  2. SelectionChange event memorize the previous value of the cell, before changing.

  3. The Change event does the job only if prevVal was not empty...

user_22333080
Related