|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Subtract contiguous values from top cell, continuously in column, till end
Hello All,
I would like to insert a formula below each range of contiguous values in a specific range (B2:X21). I would like to be able to subtract all of the contiguous values in each column from the top cell of that contiguous range. I found a macro that is an example of what I am trying to achieve but this inserts a SUM formula below every contiguous range in columns B to E. Columns F to I are manual examples of what I would like the macro to do when run. I would prefer the macro to run from a button as I am already using a Worksheet_Change and do not need it to run every time. Obviously where there is a single value as in cell C2 the macro does not need to inset a formula. Any help appreciated. Regards, Dave T |
#2
|
|||
|
|||
Try this, seems to work
Code:
Sub AutoSum() 'https://stackoverflow.com/questions/24047824/vba-excel-loop-assistance Dim Area As Range, MyColumn As String, startNum As String, SumAddr As String Dim i As Long For i = 2 To 9 'Columns B to E 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) Area.Offset(Area.Count, 0).Resize(1, 1).Formula = "=" & startNum & "-SUM(" & SumAddr & ")" Area.Offset(Area.Count, 0).Resize(1, 1).Font.Color = vbRed Skip: Next Area Next i End Sub |
#3
|
|||
|
|||
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):
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 |
#4
|
|||
|
|||
Hello Dave
the attach seems to work - the formula issue seemed to make it much more complex than it should of been and i have probably created 3 different ways of doing the samething. Not sure how efficent this is but as no one else came back with anything its worth a test Code:
Sub AutoSum() 'https://stackoverflow.com/questions/24047824/vba-excel-loop-assistance Dim Area As Range, MyColumn As String, startNum As String, SumAddr As String Dim i As Long Dim c As Range Dim cCount As Integer For i = 2 To 9 'Columns B to E 'loop through area's For Each Area In Columns(i).SpecialCells(xlConstants, xlNumbers).Areas 'what area Area.Select 'check if sumaddr is empty If SumAddr <> "" Then 'check if area overlaps with previous sum If Not Intersect(Area, Range(SumAddr)) Is Nothing Then GoTo Skip End If 'Get the start number startNum = Area.Resize(1, 1).Address(False, False) 'check if the sum area is only 1 cell If Area.Count <= 1 Then GoTo Skip 'Check if the next cell on is a formula If Area.Offset(Area.Count, 0).Resize(1, 1).HasFormula = True Then 'Loop through cells in area to find the end For Each c In Area.CurrentRegion.Offset(1, 0).Resize(, 1) cCount = cCount + 1 If c.Value = "" Then SumAddr = Range(startNum).Offset(1, 0).Resize(cCount - 1, 1).Address 'SumAddr = Area.CurrentRegion.Offset(1, 0).Resize(cCount - 1, 1).Address Range(SumAddr).Select Range(SumAddr).Offset(Range(SumAddr).Cells.Count, 0).Resize(1, 1).Select Range(SumAddr).Offset(Range(SumAddr).Cells.Count, 0).Resize(1, 1).Formula = "=" & startNum & "-SUM(" & SumAddr & ")" Range(SumAddr).Offset(Range(SumAddr).Cells.Count, 0).Resize(1, 1).Font.Color = vbRed GoTo Skip End If Next c Else: SumAddr = Area.Offset(1, 0).Resize(Area.Count - 1, 1).Address(False, False) End If Area.Offset(Area.Count, 0).Resize(1, 1).Formula = "=" & startNum & "-SUM(" & SumAddr & ")" Area.Offset(Area.Count, 0).Resize(1, 1).Font.Color = vbRed Skip: cCount = 0 Next Area Next i End Sub |
#5
|
|||
|
|||
Hello Purfleet,
Once again I really appreciate your help. Yes I surprised no one else suggested anything or even a different approach. From my many web searches I have found plenty of macros that can add a formula to the blank cell at the bottom of contiguous ranges, but these all insert a SUM formula. Your latest modification appears to have solved the cells in the contiguous ranges that contain formulas. The last thing I need is how to limit the range it works on i.e. between Row 2 and Row 21 inclusive. Unless someone else can offer a suggestion I might have to leave it there and keep looking for a work around. Thanks again, Dave T |
#6
|
|||
|
|||
I forgot about that requirement, that should be easy - 1 extra line of code
|
#7
|
|||
|
|||
with attachment!
|
#8
|
|||
|
|||
Hello Purfleet,
Sorry for late reply... Thank you very much for all the work you have put in with my question. I have been unable to access our only home computer as wife had COVID-19 testing, followed by self isolation (negative result) and then she had to work from home. Outside of wife using computer, my gaming son was using the computer. Your persistence with a solution was fantastic. Regards, David |
#9
|
|||
|
|||
Hello All,
Just thought I would ask for an alternative and slightly more manual option, that can be used on a case by case basis. If I was to manually select the blank cell below each of my contiguous calculations, is there a Worksheet_BeforeDoubleClick macro that would subtract the range of cells above the double click formula from the value in the top cell i.e top cell minus SUM below? The problem with some of the earlier solutions was that my cells contained formulas and the .SpecialCells(xlConstants, xlNumbers) looks for numbers, not formulas. I use the range of calculations to work out the axle spacing’s of different trucks. For example.... Axle 1 to 2 = 3,885 - (1,370/2) = 3,200 mm Axle 2 to 3 = 1,370 Axle 3 to 4 = 8,200 - 50 - (1,370/2) - 1,220 = 6,245 OR 8,200 - SUM(D35) = 6,245 Axle 4 to 5 = 1,220 Axle 5 to 6 = 1,220 Axle 6 to 7 = 5,810 - 1,220 - (1,380/2) = 3,900 OR 5,810 - SUM(G3:G4) = 3,900 Without attaching another workbook, I hope the above example makes sense. Regards, Dave T |
#10
|
|||
|
|||
I thought we over came the issue with formulas/values?
Anyway the attached has a doubleclick feature to calculate - i dont particually like it as any double click will invoke the macro so you will get error (that can be ironed out) Currently only working if there is nothing around the numbers to sum, otherwise it picks up all numbers, will try and look later |
#11
|
|||
|
|||
Hello Purleet,
I apologise for any confusion, and I really do appreciate all of your help. I had been looking at the various SUM example I had found on the internet and was trying to modify your first post (without the double click), hence the 'issue'. I thought that if there were minimal lines of code it might be easier to modify and completely forgot about the problem. I noted you have changed your code to now include Application.WorksheetFunction.Sum(RestOfCells) which just seems to return the result and not the formula. I must admit that having the formula was a good way of checking what cells were being used to determine the end result. The other advantage of having the formula was if I made a mistake with the data above, the formula updated the end result. Also it did not add another row if the macro was run again without deleting the previous answer. Once again, thank you very much and I hope you and your family have a good New Year. Regards, David |
#12
|
|||
|
|||
I didn’t like the double click thing - it seems to work, but a double click anywhere would set it off - personal preference. If you like it, it seems to work (with blank cells all around)
The RestofCells was an attempt as a UDF but i didn’t get time to finishing it off, again if it’s not your thing we can try other stuff. Personally i think, the code for the doubleclick thing is a decent starting point, but i would put it in the personal macro workbook so can i use it as and when then add to the QAT. If you are basically happy with the doubleclick then we can update (with a button or QAT) to leave a formula and make it work with data around it? Let me know |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Novice needs: Complicated running totals adding substracting non contiguous cells contiguous columns | innkeeper9 | Excel | 5 | 08-30-2016 04:43 PM |
Subtract value from one cell into another | otuatail | Excel | 3 | 02-01-2016 03:21 AM |
Mouseover cell to indicate mouse pointer location based on Specific Row/Column values | bolandk | Excel | 1 | 05-15-2014 08:22 AM |
Summing Non Contiguous Cells in a Row or Column | Joe Ottenhof | Excel | 4 | 12-19-2012 04:13 AM |
From a particular cell till the end of the same column | tinfanide | Excel | 3 | 08-10-2011 05:09 AM |