Shorter way of writing

[Eric Carolus]

Good day Folks

Is there perhaps a way of shortening following code?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F9:F74")) Is Nothing Then
If Target = "" Then
Range("E" & Target.Row).ClearContents
End If
End If


If Not Intersect(Target, Range("H9:H74")) Is Nothing Then
If Target = "" Then
Range("G" & Target.Row).ClearContents
End If
End If

If Not Intersect(Target, Range("J9:J74")) Is Nothing Then
If Target = "" Then
Range("I" & Target.Row).ClearContents
End If
End If

If Not Intersect(Target, Range("L9:L74")) Is Nothing Then
If Target = "" Then
Range("L" & Target.Row).ClearContents
End If
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not Intersect(Target, Range("N9:N74")) Is Nothing Then
If Target = "" Then
Range("M" & Target.Row).ClearContents
End If
End If


If Not Intersect(Target, Range("P9:P74")) Is Nothing Then
If Target = "" Then
Range("O" & Target.Row).ClearContents
End If
End If

If Not Intersect(Target, Range("R9:R74")) Is Nothing Then
If Target = "" Then
Range("Q" & Target.Row).ClearContents
End If
End If

If Not Intersect(Target, Range("T9:T74")) Is Nothing Then
If Target = "" Then
Range("S" & Target.Row).ClearContents
End If
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not Intersect(Target, Range("V9:V74")) Is Nothing Then
If Target = "" Then
Range("U" & Target.Row).ClearContents
End If
End If


If Not Intersect(Target, Range("X9:X74")) Is Nothing Then
If Target = "" Then
Range("W" & Target.Row).ClearContents
End If
End If

If Not Intersect(Target, Range("Z9:Z74")) Is Nothing Then
If Target = "" Then
Range("Y" & Target.Row).ClearContents
End If
End If

If Not Intersect(Target, Range("AB9:AB74")) Is Nothing Then
If Target = "" Then
Range("AA" & Target.Row).ClearContents
End If
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not Intersect(Target, Range("AD9:AD74")) Is Nothing Then
If Target = "" Then
Range("AC" & Target.Row).ClearContents
End If
End If


If Not Intersect(Target, Range("AF9:AF74")) Is Nothing Then
If Target = "" Then
Range("AE" & Target.Row).ClearContents
End If
End If

If Not Intersect(Target, Range("AH9:AH74")) Is Nothing Then
If Target = "" Then
Range("AG" & Target.Row).ClearContents
End If
End If

If Not Intersect(Target, Range("AJ9:AJ74")) Is Nothing Then
If Target = "" Then
Range("AI" & Target.Row).ClearContents
End If
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not Intersect(Target, Range("AL9:AL74")) Is Nothing Then
If Target = "" Then
Range("AI" & Target.Row).ClearContents
End If
End If


If Not Intersect(Target, Range("AN9:AN74")) Is Nothing Then
If Target = "" Then
Range("AM" & Target.Row).ClearContents
End If
End If

If Not Intersect(Target, Range("AP9:AP74")) Is Nothing Then
If Target = "" Then
Range("AO" & Target.Row).ClearContents
End If
End If
End Sub

Any and all help will be greatly appreciated.

Thank you

Eric

 

[DanteAmor]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("F:AP")) Is Nothing Then
    If Target.Row < 9 Or Target.Row > 74 Then Exit Sub
    If Target.Column Mod 2 = 1 Then Exit Sub
    If Target.Value = "" Then
      Target.Offset(, -1).ClearContents
    End If
  End If
End Sub

 

[Peter_SSs]

When posting vba code , please use code tags to preserve the indentation formatting of your code. Code that is all left-aligned is much harder to read/debug. My signature block below has help on that.

Before my suggested code, note that
- your code will error if more than one cell in the targeted ranges is changed at the same time.
- since your code changes something on the worksheet, it will re-call itself. Best to avoid that in most instances and my code does that with the EnableEvents lines

Instead of your code, try this

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim changed As Range, c As Range
  
  Set changed = Intersect(Target, Rows("9:74"), Range("F:F, H:H,J:J,L:L,N:N,P:P,R:R,T:T,V:V,X:X,Z:Z,AB:AB,AD:AD,AF:AF,AH:AH,AJ:AJ,AL:AL,AN:AN,AP:AP"))
  If Not changed Is Nothing Then
    Application.EnableEvents = False
    For Each c In changed
      If Len(c.Value) = 0 Then c.Offset(, -1).ClearContents
    Next c
    Application.EnableEvents = True
  End If
End Sub

 

[DanteAmor]

- your code will error if more than one cell in the targeted ranges is changed at the same time.
- since your code changes something on the worksheet, it will re-call itself. Best to avoid that in most instances and my code does that with the EnableEvents lines

Good point Peter, you're right. And if you allow me, taking your proposal and a small part of mine, it could be like this:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c As Range, changed As Range
  Set changed = Intersect(Target, Range("F:AP"), Rows("9:74"))
  If Not changed Is Nothing Then
    Application.EnableEvents = False
    For Each c In changed
      If c.Value = "" And c.Column Mod 2 = 0 Then c.Offset(, -1).ClearContents
    Next
    Application.EnableEvents = True
  End If
End Sub

I understand that in this way it will review all the cells in columns F to AP and even the condition will discard the columns, perhaps it will make the process slower if they modify a large number of cells, but with few cells it will not be perceived.

 

[Eric Carolus]

Hi
DanteAmor & Peter_SSs

Both Codes work just fine!

Question though. In one of the ranges I merged two cells
and as a result, just in THOSE CASES the code does
not work.

Any ideas?

Thanks
Eric

 

[Peter_SSs]

In one of the ranges I merged two cells

Tell us about where the merged cells are.

 

[Eric Carolus]

Hallo Peter_SSs and DanteAmor

The range is is AA55: AP73 (bearing in mind the previous info)

Thank you.

Eric

 

[Peter_SSs]

The range is is AA55: AP73

Is that an answer to this (remembering that you stated that you had merged two cells in one of the ranges)?

Tell us about where the merged cells are.

 

[Eric Carolus]

Hi Peter_SSs

I decided to include an image.

The yellowish cells below the red line
is where the code does not work.

Thanks again for you trouble

Eric

 

[Peter_SSs]

The yellowish cells below the red line
is where the code does not work.

OK, so you don't just have two merged cells, you have lots of "two merged cells".

I decided to include an image.

Whilst that helps with our understanding, we cannot copy it for testing. Can you post that sample section again with XL2BB so that we can copy/paste to our own sheets without having to type it all out manually?

Are you still wanting the code to work on every second column from F to AP or now only AA to AP?

And are the rows to check now only 55:73 or still 9:74?