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

[DocAElstein]

Macro for last post, and for second answer to this Thread
https://excelfox.com/forum/showthrea...ll=1#post14831

Public Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("G16:G34")) Is Nothing Or Not Application.Intersect(Target, Range("I16:I34")) Is Nothing Then ' we only go any further if we have an intersect between  Target - the range we changed, and one of the column ranges of interest
        If Range("A" & Target.Row & "").Value2 = "" Then   '  We are only intertsted in putting a value in column A to update an ittem number if there is not already one in there
        ' get current maximum item number info: wjat is it, and where is it
        Dim Cnt As Long, Mx As Long, MxInd As Long ' MxInd is for the Item number at which we got the maximum , - I need this to know where to put the new  ITEM
        Dim RngA As Range: Set RngA = Range("A16:A34")
            For Cnt = 1 To RngA.Rows.Count Step 1
                If Mx < RngA.Item(Cnt).Value Then ' In Excel Ranges cell item numbers are counted  along columns then next rows  etc. So for a single column, each next item number is the next row
                 Let Mx = RngA.Item(Cnt).Value
                 Let MxInd = Cnt
                Else
                
                End If
            Next Cnt
        ' update current row item number to be the current highest, and make previous highest one more
         Let Application.EnableEvents = False ' I have to temporarily turn this thing off, or else the next line makes this macro start again
         Let Range("A" & Target.Row & "").Value2 = Mx: Let RngA.Item(MxInd).Value2 = Mx + 1
         Let Application.EnableEvents = True
        Else
        ' Column A already has a number in so no item number update
        End If
    ' Doing the sum calculations
    Dim RngG As Range: Set RngG = Range("G16:G34")
    ' Build Sting Of Rows With Shape Line And Sum Column If No Shape Line   https://excelfox.com/forum/showthread.php/2561-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)-Event-Coding?p=14844&viewfull=1#post14844
    Dim strLnRws As String: Let strLnRws = " "
    Dim Sp As Shape
        For Each Sp In RngG.Worksheet.Shapes
            If Sp.Name Like "Line*" Then
             Let strLnRws = strLnRws & Sp.TopLeftCell.Row & " "
            Else
            End If
        Next
    Dim RngJ As Range: Set RngJ = Range("J16:J34")
        For Cnt = 1 To RngG.Rows.Count Step 1
        Dim SumG As Double
            If InStr(1, strLnRws, " " & RngG.Item(Cnt).Row & " ", vbBinaryCompare) = 0 And RngG.Item(Cnt).Value2 <> "" Then
             Let SumG = SumG + RngG.Item(Cnt).Value2
            Else
            ' there is no value or it is struck through
            End If
        Dim SumJ As Double
            If InStr(1, strLnRws, " " & RngJ.Item(Cnt).Row & " ", vbBinaryCompare) = 0 And RngJ.Item(Cnt).Value2 <> "" Then
             Let SumJ = SumJ + RngJ.Item(Cnt).Value2
            Else
            ' there is no value or it is struck through
            End If
        Next Cnt
     Let Application.EnableEvents = False
     Let Range("G35").Value2 = SumG: Let Range("J35").Value2 = SumJ
     Let Application.EnableEvents = True
    Else
    ' did not make change in column ranges of interset
    End If
End Sub

I have put this in the worksheet object code module of worksheet "Sheet2 excelforum jindon" in the uploaded file: -
help0824.xls : https://app.box.com/s/fkfuld8yk4xrna5vt069x75intiyzs8i