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

[DocAElstein]

Macro for this post
https://excelfox.com/forum/showthrea...ll=1#post14848

In ThisWorkbook code module

Option Explicit
Private Sub Workbook_Open()
 Let Sheet3.UsdRws = Worksheets.Item(3).UsedRange.Rows.Count
End Sub

In third worksheets object code module

Option Explicit
Public UsdRws  As Long
Public Sub Worksheet_Change(ByVal Target As Range)
    If Me.UsedRange.Rows.Count = UsdRws + 1 Then ' We added a row
     Let Application.EnableEvents = False
     Let Range("J" & Target.Row & "").Value = "=IF(OR(RC[-3]="""",RC[-1]=""""),"""",RC[-3]*RC[-1])"
     Let Application.EnableEvents = True
     Let UsdRws = UsdRws + 1
     Exit Sub ' No more will be done after a row insert
    Else
    End If
    
    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  Note: this would also be set off by a row insertion, but we will not let it because we exited before
    ' Dynamic Lr
    Dim Lr As Long: Let Lr = Range("J" & Rows.Count & "").End(xlUp).Row - 1
        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
         Let Application.EnableEvents = False
         Let Range("A" & Target.Row & "").Value2 = "anything" ' Put anything in for now
         Let Application.EnableEvents = True
        Dim RngA As Range: Set RngA = Range("A16:A" & Lr & "")
        Dim Cnt As Long, ACel As Range
            For Each ACel In RngA.SpecialCells(xlCellTypeConstants) ' Each cell with something in it in column A
             Let Cnt = Cnt + 1
             Let Application.EnableEvents = False
             Let ACel.Value = Cnt  ' The next cell down is given the next number
             Let Application.EnableEvents = True
            Next ACel
        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:G" & Lr & "")
    ' 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:J" & Lr & "")
        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("G" & Lr + 1 & "").Value2 = SumG: Let Range("J" & Lr + 1 & "").Value2 = SumJ
     Let Application.EnableEvents = True
    Else
    ' did not make change in column ranges of interset
    End If
End Sub