Combining multiple Worksheet change events

[Merkage]

Hello guys and gals,
I'm a rookie to VBA and currently trying to combine two separate worksheet changes to my excel sheet. Both work individually, but i haven't found a way to combine them to run. I want them to change certain cells to N/A, dependent on the data in other cells. I know the codes are bulky and over-complicated, so any tips in reducing and combining them would be greatly appreciated!!

Thanks in advance,
Sam

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell As Range
    Dim onlyThese As Range   ' collection of ranges that trigger  action
    Dim cellsToUse As Range  ' cells that are both in "Target" and in "onlyThese"
    
    On Error GoTo Error


    Application.EnableEvents = False


    Set onlyThese = Range("D:D") ' Range of CRF to be N/A
    Set cellsToUse = Intersect(onlyThese, Target)
    If cellsToUse Is Nothing Then GoTo Letscontinue
    
    ' loop over cells that are to be N/A:
    For Each aCell In cellsToUse
        If aCell.Value = "N/A" Then
            aCell.Offset(0, 1).Value = aCell.Value
            aCell.Offset(0, 17).Value = aCell.Value
            aCell.Offset(0, 18).Value = aCell.Value
            aCell.Offset(0, 19).Value = aCell.Value
            aCell.Offset(0, 24).Value = aCell.Value
            aCell.Offset(0, 25).Value = aCell.Value
            aCell.Offset(0, 26).Value = aCell.Value
            aCell.Offset(0, 31).Value = aCell.Value
            aCell.Offset(0, 32).Value = aCell.Value
            aCell.Offset(0, 33).Value = aCell.Value
            aCell.Offset(0, 38).Value = aCell.Value
            aCell.Offset(0, 39).Value = aCell.Value
            aCell.Offset(0, 40).Value = aCell.Value
              End If
            If aCell.Value = "" Then
            aCell.Offset(0, 1).Value = aCell.Value
            aCell.Offset(0, 17).Value = aCell.Value
            aCell.Offset(0, 18).Value = aCell.Value
            aCell.Offset(0, 19).Value = aCell.Value
            aCell.Offset(0, 24).Value = aCell.Value
            aCell.Offset(0, 25).Value = aCell.Value
            aCell.Offset(0, 26).Value = aCell.Value
            aCell.Offset(0, 31).Value = aCell.Value
            aCell.Offset(0, 32).Value = aCell.Value
            aCell.Offset(0, 33).Value = aCell.Value
            aCell.Offset(0, 38).Value = aCell.Value
            aCell.Offset(0, 39).Value = aCell.Value
            aCell.Offset(0, 40).Value = aCell.Value
        End If
    Next
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Error:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)    Dim bCell As Range
    Dim onlyTheseb As Range   ' collection of ranges that trigger  action
    Dim cellsToUseb As Range  ' cells that are both in "Target" and in "onlyThese"
    
    On Error GoTo Error


    Application.EnableEvents = False
    
    Set onlyTheseb = Range("J:J") ' Range of cells to be N
    Set cellsToUseb = Intersect(onlyTheseb, Target)
    If cellsToUseb Is Nothing Then GoTo Letscontinue
    ' cells that are to be N/A:
    For Each bCell In cellsToUseb
        If bCell.Value = "N" Then
            bCell.Offset(0, 3).Value = "N/A"
              End If
            If bCell.Value = "" Then
            bCell.Offset(0, 3).Value = bCell.Value
        End If
     Next
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Error:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

This might be a first pass:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aCell       As Range
    Dim onlyThese   As Range   ' collection of ranges that trigger  action
    Dim cellsToUse  As Range   ' cells that are both in "Target" and in "onlyThese"
    
    On Error GoTo Error
    Application.EnableEvents = False

    Set onlyThese = Range("D:D") ' Range of CRF to be N/A
    Set cellsToUse = Intersect(onlyThese, Target)
    If Not cellsToUse Is Nothing Then
        ' loop over cells that are to be N/A:
        For Each aCell In cellsToUse
            If aCell.Value = "N/A" Or aCell.Value = "" Then
                aCell.Offset(0, 1).Value = aCell.Value
                aCell.Offset(0, 17).Value = aCell.Value
                aCell.Offset(0, 18).Value = aCell.Value
                aCell.Offset(0, 19).Value = aCell.Value
                aCell.Offset(0, 24).Value = aCell.Value
                aCell.Offset(0, 25).Value = aCell.Value
                aCell.Offset(0, 26).Value = aCell.Value
                aCell.Offset(0, 31).Value = aCell.Value
                aCell.Offset(0, 32).Value = aCell.Value
                aCell.Offset(0, 33).Value = aCell.Value
                aCell.Offset(0, 38).Value = aCell.Value
                aCell.Offset(0, 39).Value = aCell.Value
                aCell.Offset(0, 40).Value = aCell.Value
            End If
        Next
    End If
    
    Set onlyThese = Range("J:J") ' Range of cells to be N
    Set cellsToUse = Intersect(onlyThese, Target)
    If Not cellsToUse Is Nothing Then
        ' cells that are to be N/A:
        For Each aCell In cellsToUse
            If aCell.Value = "N" Then aCell.Offset(0, 3).Value = "N/A"
            If aCell.Value = "" Then aCell.Offset(0, 3).Value = aCell.Value
         Next
     End If
     
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Error:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

It may be possible to shorten it some more but I can't understand what you are trying to do, exactly.

Regards,

 

[Merkage]

Thanks Rickxl,
I managed to find a very clean way of calling the two separate codes into the worksheet change, rather than putting in the code itself.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call ChangeEvent1(Target)
    Call ChangeEvent2(Target)
End Sub

 

[RickXL]

Good idea!

Thanks for letting me know.

Regards,