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

 

[Eric Carolus]

Hi Peter_SSs

I have tried to import the Add-inn but on THIS COMPUTER it did not work.
I copied the Add-Inn to an OLDER COMPUTER AND THE Add-inn worked just fine!

Thank you folks!
So here it is, the one page called ' ALLOCATON' : Workbook

 

[Peter_SSs]

I have tried to import the Add-inn but on THIS COMPUTER it did not work.

1. What version of Excel do you have on that computer & what operating? Is it Excel 2016 on Windows (what version?) on both machines?
2. In what way did it not work on that computer? That is, at what point in the installation or use instructions did it fail and what were the symptoms (eg error message? Excel crashes? etc)?


Thanks for the file link but that didn't resolve the questions that I had asked:

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?

 

[Eric Carolus]

Hi Peter_SSs

Are you still wanting the code to work on every second column from F to AP or now only AA to AP?
I want the code to work F to AP
And are the rows to check now only 55:73 or still 9:74?
The rows are 9 to 74.

I only included the one pager as the merged cells (yellowish) only appear on that page.

Computers

The one pager I sent you is part of an application developed my current computer.
It runs Office 2016 on a Windows 10 platform
Previously I had reinstalled Office 2016.
I had reinstalled because I bought an Add in (to protect intellectual property) from the Internet
and message came up that the Addin is hampering Excel's operation.

The older computer has Office 2016 and would not even switch on today!

Eric

 

[Peter_SSs]

Hi Peter_SSs

Are you still wanting the code to work on every second column from F to AP or now only AA to AP?
I want the code to work F to AP
And are the rows to check now only 55:73 or still 9:74?
The rows are 9 to 74.

I only included the one pager as the merged cells (yellowish) only appear on that page.

Thanks for the clarification.

Merged cells obviously consist of more than one cell. You have some existing Worksheet_Change code above the code I suggested. In that existing code is a line that says
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub

So when you clear one of those merged cells that line executes the 'Exit Sub' command so the code never gets to what I suggested.

Try this ..
a) Move my suggested code to the very top of the Worksheet_Change code, and
b) Change this line in my code

If Len(c.Value) = 0 Then c.Offset(, -1).ClearContents
If Len(c.Value) = 0 Then c.Offset(, -1).Value = ""

Thanks also for the information about your computers and the XL2BB Add-In.

 

[Eric Carolus]

Peter_SSs

You are a star!

It works like a charm!
Thanks again!

Eric

 

[Peter_SSs]

You're welcome. Glad we got there in the end.