VBA WORKSHEET CHANGE

[robertmwaring2]

First, please let me clarify that I am not fluent in VBA, but research what I can to do what I need to on occasion.

Here is a link to the sheet for reference, but including the information below as well: <Click here for Workbook>

A little about the sheet: I am trying to figure out how to make different modules run based on specific cell changes in a worksheet change event btu cannot for the life of me figure out what I am doing wrong. On the sheet in question, the first range(s) that i want to trigger one macro is rows 2:36 in columns A,C, E, G, and I, I am trying to avoid refernces to a specific sheet because there will be 13 other sheets with the same structure that will need the same worksheet change event coding. the second range(s) on the sheet that will trigger a different macro is row 2, but every 4th column beginning at X and continuing to AAR. In part of the code I have come up with, I attempted to ensure that once the macro has run, the selected cell on the sheet is the changed cell (either the cell itself if info was deleted, or the row beneath it if something was entered into the cell.) Below is what I have thus far that I cannot get to come together -

Private Sub Worksheet_Change(ByVal Target As Range)
'call module 1 to create a list of all menu items on the sheet
    If Intersect(Target, Range("A2:J36")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Call CombineMenuLists
    'after list is compiled, returns to cell below changed cell if changed cell is not blank
    If Range(Target.Address).Value <> "" Then
    Range(Target.Address).Offset(1, 0).Select
    End If
   'if changed cell is blank, returns to changed cell
    If Range(Target.Address).Value = "" Then
    Range(Target.Address).Select
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True

'call module 2 to create a list of all display names on the sheet
    If Not Intersect(Target, Range("X2:AAU2")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Call DisplayList
    'after list is compiled, returns to cell below changed cell if changed cell is not blank
    If Range(Target.Address).Value <> "" Then
    Range(Target.Address).Offset(1, 0).Select
    End If
    'if changed cell is blank, returns to changed cell
    If Range(Target.Address).Value = "" Then
    Range(Target.Address).Select
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
  End Sub

A little about the macros: for the range(s) that include columns A, C (etc) - the macro is to simply copy the info (from first to last item) in each individual column and paste them into column U. pretty straight forward and I have determined that if I run this macro by itself, it works as intended. so I dont believe this is the issue but here is the coding for review:

Sub CombineMenuLists()
ActiveSheet.Select
Range("U2", Range("U2").End(xlDown)).Clear
If IsEmpty(Range("A2").Value) = False Then
Range("a2", Range("a2").End(xlDown)).copy
Range("U2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
If IsEmpty(Range("C2").Value) = False Then
Range("C2", Range("C2").End(xlDown)).copy
Range("U2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
If IsEmpty(Range("E2").Value) = False Then
Range("E2", Range("E2").End(xlDown)).copy
Range("U2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
If IsEmpty(Range("G2").Value) = False Then
Range("G2", Range("G2").End(xlDown)).copy
Range("U2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
If IsEmpty(Range("I2").Value) = False Then
Range("I2", Range("I2").End(xlDown)).copy
Range("U2").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
End Sub

The second macro will to run for cahnges in every 4th column of row 2 beginning at X is as follows:

Sub DisplayList()
ActiveSheet.Select
Range("t17:t400").Value = ""
Dim rRange As Range
Dim rEveryNth As Range
Dim lRow As Long
With ActiveSheet
Set rRange = .Range("S17:S716")
End With
For lRow = 1 To rRange.Rows.Count Step 4
If lRow = 1 Then
Set rEveryNth = rRange(lRow, 1)
Else
Set rEveryNth = Union(rRange(lRow, 1), rEveryNth)
End If
Next lRow
Application.Goto rEveryNth
    Selection.copy
    Range("T17").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    ActiveSheet.Range("$T$16:$T$191").AutoFilter Field:=1, Criteria1:="<>"
    Range("t17", Range("t17").End(xlDown)).copy
    Range("V2").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    ActiveSheet.Range("$T$16:$T$191").AutoFilter Field:=1
End Sub

I realize all this information is likely extra, but am trying to be clear what is happening so sorry. Thank you in advance to anyone who can help! I greatly appreciate it. As a last resort, I was simply going to resort to command buttons, but was trying to avoid the chance that someone may neglect to use them in the event information was changed,

Sincerely,

Robert

 

[tdinsdale]

Box

app.box.com

Above, is the shared link. Let me know if there are any additional question. Thanks for your help.