Hello Purfleet,
I really appreciate your response and it has given me something to play with.
Whilst your solution works well, I have noted some problems with how I plan to use it.
I have been working on modifying what you have written (what I have done may not be the best way, so feel free to comment):
- I only wanted it to work with the range B2:X21 as I have other formulas below, so how do I restrict it to only apply to cells from Row 2 to Row 21 and Columns B to X?
- In my example I had data from Column B to Column I, but the number of columns from B across varies. It appears my additions may have solved this part.
- Sometimes the values within the contiguous range may be formulas i.e. =2440/2.
Your macro overwrites any formulas in these cells.
Here is what I have been playing with so feel free to comment:
Code:
Sub AutoSubtract_v2()
'https://stackoverflow.com/questions/24047824/vba-excel-loop-assistance
'https://www.msofficeforums.com/excel-programming/46058-subtract-contiguous-values-top-cell-continuously-column.html
Dim Area As Range
Dim startNum As String
Dim SumAddr As String
Dim i As Long
On Error GoTo NoBlanks
Dim N As Long
'N = Sheet1.Cells(2, Columns.Count).End(xlToLeft).Column
N = Cells(2, Columns.Count).End(xlToLeft).Column
For i = 2 To N
NoBlanks:
Resume Next
For Each Area In Columns(i).SpecialCells(xlConstants, xlNumbers).Areas
If Area.Count <= 1 Then GoTo Skip
startNum = Area.Resize(1, 1).Address(False, False)
SumAddr = Area.Offset(1, 0).Resize(Area.Count - 1, 1).Address(False, False)
With Area.Offset(Area.Count, 0).Resize(1, 1)
.Formula = "=" & startNum & "-SUM(" & SumAddr & ")"
.Font.Color = vbRed
.Font.Bold = True
.Interior.Color = RGB(255, 255, 204)
End With
Skip:
Next Area
Next i
End Sub
Regards, Dave T