Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

[DocAElstein]

First macro for this Post:
https://excelfox.com/forum/showthrea...4913#post14913

Sub TestieCalls()
 Call Me.Worksheet_Change(Me.Range("B4"))
End Sub

Public Sub Worksheet_Change(ByVal Target As Range)
Dim Lr As Long, Lc As Long
 Let Lr = Me.Range("B" & Me.Rows.Count & "").End(xlUp).Row
 Let Lc = Me.Cells(4, 2).End(xlToRight).Column             '  I am using a slightly less common way including   xlToRight   because there are some explanation wordings that would be found giving a false number by the more typically used    Columns.Count xlToLeft   way
Dim RngTbl As Range: Set RngTbl = Me.Range("B4:" & CL(Lc) & Lr & "")
    If Application.Intersect(Target, RngTbl) Is Nothing Then
     Exit Sub ' I did not change anything in the table
    Else
     Let Application.EnableEvents = False
     Let Me.Range("A1").Value = "No Remarks"
     Let Application.EnableEvents = True
    Rem Loop
    Dim arrTbl() As Variant: Let arrTbl() = RngTbl.Value2
    Dim Cnt
        For Cnt = 1 To UBound(arrTbl(), 1) ' Loop "down" "rows" in table array
        Dim Clm As Long: Let Clm = 2 ' "column" in table array
        Dim Decs As Long
            'For Clm = 2 To UBound(arrTbl(), 2) - 1 ' loop from second to last but one "column" in table array
            Do
                If arrTbl(Cnt, Clm + 1) >= arrTbl(Cnt, Clm) Then ' we no longer have a decresing sequence
                 Let Decs = 0 ' Reset the count of sequential decreasing values
                Else ' we have at least 2 sequential decreses, possibly 3
                 Let Decs = Decs + 1
                End If
            'Next Clm
             Let Clm = Clm + 1
            Loop While Clm < UBound(arrTbl(), 2) And Decs < 2
            'If Clm = UBound(arrTbl(), 2) Then ' this will occur if we did not exit the   For  loop
            If Decs = 2 Then ' If decs = 2 we had three seqeuntial decreses = sequentially 2 x arrTbl(Cnt, Clm + 1) < arrTbl(Cnt, Clm)
            Dim StrRemmark As String
             Let StrRemmark = StrRemmark & " and " & arrTbl(Cnt, 1)
            Else
            End If
         Let Decs = 0 ' reset the count of sequential decreasing values so that  Decs  can be used in the next main row loop
        Next Cnt
    End If
' add remark
    If StrRemmark <> "" Then
     Let StrRemmark = Mid(StrRemmark, 6) ' this takes off the first  " and "
     Let Application.EnableEvents = False
     Let Me.Range("A1").Value = "Student is decreasing in " & StrRemmark
     Let Application.EnableEvents = True
    Else
    ' no remmark
    End If
End Sub
Public Function CL(ByVal lclm As Long) As String '         http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
    Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function