I was trying to do an automation and i was stuck here, where i need to add sum formula dynamically in between the space ranges. I'm completely lost here for adding formula using VBA can anyone help me out.
Thank you in advance :)
I'm assuming what you want is if there is a blank in a cell, you want all of the other elements summed and the result placed in that blank. There are probably any number of ways to code this, but here is my attempt
Sub formulateSubtotals()
finalRow = Cells(Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row
finalCol = Cells(1, Worksheets("Sheet1").Columns.Count).End(xlToLeft).Column
For j = 1 To finalCol
For i = finalRow + 1 To 1 Step -1
If IsEmpty(Cells(i, j)) Then
If IsEmpty(Cells(i - 2, j)) Then
firstRow = i - 1
lastRow = firstRow
Else
lastRow = i - 1
firstRow = Cells(i - 1, j).End(xlUp).Row
End If
Cells(i, j) = Application.WorksheetFunction.Sum(Range(Cells(firstRow, j), Cells(lastRow, j)))
End If
Next i
Next j
End Sub
This also assumes that the sheet in question is entitled "Sheet1".
Without VBA:
Say we have data in column A like:
and we want to calculate of sum of each of the blocks separated by a blank cell. In B2 enter:
=IF(A2<>"","",SUM($A$1:A2)-SUM($B$1:B1))
and copy down:
If this is of no value, I will delete the answer.
Related
'The code should add the moving average to last row using array. The Prices to be use to average are in range "E6:E7555". The values will be written in "G7555". There is an existing moving average values in range "G6:G7554". Need help from Excel VBA expert to correct the codes which I think in step 1 and 2 below.
Options Explicit
Sub Add_MovingAverage_to_LastRows()
Dim maArray As Variant
Dim runSum, ma() As Double
Dim i, lRow, iPeriod, iCol As Long
iPeriod = 7
'set last row and reference range to calculate
With Worksheets("Sheet1")
lRow = .Cells(Rows.Count, 1).End(xlUp).Row 'Row "7555"
maArray = .Range(.Cells(lRow - (iPeriod -1), 5), .Cells(lRow, 5)).Value2 'Column "E"
End With
'set the lower and upper bound
ReDim ma1(lRow - (iPeriod - 1) To lRow, 1 To 1)
'step 1 calculate the SUM for last row, sum (row "7549" to row "7555")
runSum = 0
For i = lRow - (iPeriod-1) To lRow
runSum1 = runSum1 + maArray(i, 1)
Next
'step 2 calculate the AVERAGE for last row, average (row "7549" to row "7555")
ma(1, 1) = runSum / iPeriod
'write the values to worksheet
iCol = 7 'Column "G"
With Worksheets("Sheet1")
.Range(.Cells(lRow, iCol), .Cells(lRow, iCol)).Value2 = ma
End With
Erase maArray: Erase ma
End Sub
I think you may want to stick to a Formula on G column instead of VBA. If you add this formula on G6 and drag down: (Test it out on column H next to it)
=AVERAGE(INDIRECT("E"&IF(ROW()-6<6,6,ROW()-6)&":"&"E"&ROW()))
The IF Statement is to not break the formula on the first few rows of the file.
It will always grab the last 6+current row of values in Column E to calculate the Average.
Edit: Summary
="E"&IF(ROW()-6<6,6,ROW()-6)&":"&"E"&ROW() if you paste this into I6 and drag down you can see how it is just graving the 7 Cell Range you are looking for. When you enclose this into INDIRECT then you can use this inside other formulas as a "literal range" as in my answer above with AVERAGE.
Edit 2: VBA Code to automatically drag/fill down formula.
Sub UpdateFill()
Dim lRow As Long, lFormulaRow
With ThisWorkbook.Sheets("Sheet1")
lDateRow = .Cells(Rows.Count, 1).End(xlUp).Row
lFormulaRow = .Cells(Rows.Count, 7).End(xlUp).Row
If lDateRow > lFormulaRow Then
.Range("G" & lFormulaRow & ":G" & lDateRow).FillDown
End If
End With
End Sub
I am fairly new in excel vba scenario. What I am trying to accomplish here in this macro is,
I have two sheet, two column, sheet1 Column A, sheet2 Column A, both have possible matches in column A. I am trying to find all the matches between two sheets and copy matched entire rows from sheet1 to exactly below matched rows in sheet two with the header of sheet1.
sheet1
Data-----------name
012-----------AAA
022-----------BBB
033-----------CCC
Sheet2
id-----------address
012-----------NYC
021-----------Philly
033-----------CT
Result
id-----------address
012-----------NYC
Data-----------name
012-----------AAA
021-----------Philly
033-----------CT
Data-----------name
033-----------CCC
The code I have so far only copying the first row, no idea how to fix it.
Sub oneMacro()
Dim lastrowone As Integer, lastrowtwo As Integer
lastrowone = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrowtwo = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrowone
For j = 2 To lastrowtwo
If Sheets("Sheet1").Cells(i, "A").Value = Sheets("Sheet2").Cells(j, "A").Value Then
Sheets("Sheet1").Cells(i, "A").EntireRow.Copy
Sheets("Sheet2").Cells(j, "A").Offset(1).Insert Shift:=xlDown
End If
Next j
Next i
End Sub
There are a couple of problems with your code. First off, to help you learn how you could trouble shoot this... First you would want to add some breakpoints, and setup a few watches. But you will see that your loops are setup perfecly at first, but do not adapt properly as you add data.
Pretty much your loop statement continues looping until the your hit lastrowtwo which at first is set for a value of 3 (based on your example above). Instead your code needs to add +1 each time you find a true result to the lastrowtwo variable. I have modified your code below to overcome this issue.
Another issue is that you are coping everything from one cell to another, then shifting it down. When doing this, you will comparing that next (which will come back as being a match). After a while you will see that this only will scan the first line item. To overcome this you can simply skip the next line in the loop check statement. You can do this by adding +1 to the j variable. See below for the modifications.
Sub oneMacro()
Dim lastrowone, lastrowtwo As Long
lastrowone = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrowtwo = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrowone
For j = 2 To lastrowtwo
If Sheets("Sheet1").Cells(i, 1).Value = Sheets("Sheet2").Cells(j, 1).Value Then
Sheets("Sheet1").Cells(i, 1).EntireRow.Copy
Sheets("Sheet2").Cells(j, 1).Offset(1).Insert Shift:=xlDown
j = j + 1 ' Modified = this must be added to overcome an issue with DOUBLE checking the newly inserted data
lastrowtwo = lastrowtwo + 1 ' Modified = This is added to overcome an issue with not completing all rows
End If
Next j
Next i
End Sub
I have a report generated from a program that opens in excel similar to the image below
I have been using this code to sum the amounts:
Sub SumTotals()
lastrow = Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row
Range("b" & lastrow + 1) = WorksheetFunction.Sum(Sheets("sheet1").Range("b2:b" & lastrow))
Range("a" & lastrow + 1) = Cells(1, 1)
Range("a1:b" & lastrow).Select
Selection.Delete Shift:=xlUp
End Sub
The issue I am running into is that the code sums both company A and company B and the ends up
Company A 5,625.07
What I am trying to accomplish is
Company A 2,053.73
Company B 3,571.34
When I get these reports there is generally 100 + companies so if I can speed up the process it would be very beneficially.
I suspect the first line of code is the problem
lastrow = Sheets("sheet1").Cells(Rows.Count, 2).End(xlUp).Row
As this is placing the end at cell B8 instead of B3. I am trying to figure out how to sum the first column of numbers until the first blank row, and then carry on to the numbers below and carry out the same process. Any suggestions are appreciated.
ideal end result
Ideal result
Try this
Sub x()
Dim r As Range
For Each r In Columns(2).SpecialCells(xlCellTypeConstants).Areas
r(r.Count + 1).Value = Application.Sum(r)
r(r.Count + 1).Offset(, -1).Value = r(1).Offset(, -1).Value
r.EntireRow.Delete shift:=xlUp
Next r
End Sub
You can also try this non VBA approach. Enter this formula =IF(A1<>"",SUM(OFFSET(B1,0,0,MIN(IF(B1:B80="",ROW(B1:B80))))),"") in cell C1 to sum all values before blank row. drag formula to the bottom of your values. Since it is an array formula, you must enter it using CTRL+SHIFT+ENTER. You can then filter out blank values in column A to get your result.
I am trying to create a rolling twelve month sum in excel using vb. The last column with data is dynamic so I created a variable to store that column number each time. I then tried to create a loop that would output the sum of the previous 12 cells and move to the next cell until it reached 12 calculation cells. But this is not working... Is there something obvious that I am doing wrong?? Thanks!
Sub OSR_ReportComplete()
Dim lCol As Long
Dim p As Integer
lCol = Cells(7, Columns.Count).End(xlToLeft).Column
For p = 0 To 12
Range(Cells(15, lCol - p)).Value = Application.Sum(Range(Cells(7, lCol -
p), Cells(7, lCol - p - 12)))
Next p
End Sub
Could be done in a neater way but this works
Sub OSR_ReportComplete()
Dim lCol As Long
Dim p As Integer
lCol = Cells(7, Columns.Count).End(xlToLeft).Column
For p = 0 To 12
Cells(15, lCol - p) = Application.Sum(Range(Cells(7, lCol - p), Cells(7, lCol - p - 12)))
Next p
End Sub
Also, If your lCol evaluates to a value less then 25 it will fall over though due to trying to reference a column less than 1. I'd recommend using Offset instead
However, a rolling total can be done very easily in excel formulas also. Say your first value is in Column A and your date is in row 1, in row 2 enter in Column A =SUM($A$1:A1) and drag along the rest of your range
Giving:
Formulas:
The following code will generate the formulas above for row 1 in one line instead of doing your loop. This is an example as I don't understand the layout of your sheet from your code
Sub OSR_ReportComplete2()
With Range(Cells(1, 1), Cells(1, Columns.Count).End(xlToLeft))
.Offset(1, 0).Formula = "=SUM(" & .Cells(1).Address & ":" & Split(.Cells.Address(RowAbsolute:=False, ColumnAbsolute:=False), ":")(0) & ")"
End With
End Sub
This is easier to write in R1C1 notation (however will be displayed in A1 in Excel Sheet)
Sub OSR_ReportComplete2()
With Range(Cells(1, 1), Cells(1, Columns.Count).End(xlToLeft))
.Offset(1, 0).FormulaR1C1 = "=SUM(" & .Cells(1).Address(ReferenceStyle:=False) & ":R[-1]C)"
End With
End Sub
First of all, I suggest you don't use VBA for this. Instead, use the inbuilt OFFSET function, like this.
Your code is quite complex, but maybe you should be using xlToRight instead of xlToLeft to find the last column.
If you want to use VBA, you can try using WorkSheetFunction.offset, putting it into a range variable and then summing that range.
Range of object error coming up with this code (error 1004).
Can you please help me out debug this?
Sub ggg()
last = Sheet1.Cells(1, 1).End(xlDown).Row
last1 = Sheet2.Cells(1, 1).End(xlDown).Row
Sheet1.Range(Cells(1, 1), Cells(last, 2)).Copy Sheet2.Range(last1 + 1, 1)
End Sub
The problem is that this doesn't find the last used cell
last = Sheet1.Cells(1, 1).End(xlDown).Row
last1 = Sheet2.Cells(1, 1).End(xlDown).Row
It sometimes jumps to the very last cell of Excel and then you try to add +1 here
Sheet2.Range(last1 + 1, 1)
which fails because there is no additional cell after the very last cell.
Use
last = Sheet1.Cells(Sheet1.Cells.Rows.Count, 1).End(xlUp).Row
last1 = Sheet2.Cells(Sheet2.Cells.Rows.Count, 1).End(xlUp).Row
to find the last used cell.
Second problem is that Sheet2.Range(last1 + 1, 1) doesn't accept two numeric parameters (as YowE3K pointed out in the comment). Therefore use Sheet2.Cells(last1 + 1, 1)
VBA Best Practices include (1) to never assume the worksheet and (2) use fully qualified cell objects.