After I have selected a range containing numerical values, I want to, via VBA, input a =SUM formula at the bottom of each column, i.e. on the row after the last selected row. For each column it should sum all of the values in the corresponding column of the entire selection.
How can I do this?
Right now, I am using the code given by the macro recorder: ActiveCell.FormulaR1C1 = "=SUM(R[-10]C:R[-1]C)". The problem is when my range gets bigger than 10 rows it will not take the rows above the bottom 10 into consideration.
Here is a simple non-VBA Approach.
Select the cells where you want the sum and press Alt-=.
SNAPSHOT
And here is a one-line VBA code that does the same thing.
Sub AutoSum()
'~~> After you select your range
Application.CommandBars.ExecuteMso ("AutoSum")
End Sub
This works:
Sub MakeSums()
Dim source As Range
Dim iCol As Long
Dim nCol As Long
Dim nRow As Long
Set source = Selection
nCol = source.Columns.Count
nRow = source.Rows.Count
For iCol = 1 To nCol
With source.Columns(iCol).Rows(nRow).Offset(1, 0)
.FormulaR1C1 = "=SUM(R[-" & nRow & "]C:R[-1]C)"
.Font.Bold = True
End With
Next iCol
End Sub
Example:
You could also do something like this without VBA:
=SUM(OFFSET(INDIRECT(CELL("address")),1-ROW(),0,ROW()-1,1))
This will sum all cells above the cell in which the formula exists.
Here is a quick trick to sum selected cells in vba code.
Private Sub Sum_Click()
MsgBox Application.Sum(Range(Selection.Address))
End Sub
This is what I was searching for when I landed on this thread so maybe it will help someone.
Related
I need help placing a formula in row 51 from column A to AE on sheet "COPY". The formula is "Trim(A1)" and needs to be dragged until "Trim(AE1)" while still being in row 51 (A51:AE51)
This is what I have so far, but its pulling up an error on "lascolumn = range..."
Sub INSERT_TRIM_COPY()
Sheets("COPY").Select
Dim Lastcolumn As Long
Lastcolumn = Range("A:AE" & Columns.Count).End(xlToRight).Column
Range("A51:AE51" & Lastcolumn).FORMULA = "=TRIM(A1)"
End Sub
You need to use: Range(Cells(51,1), Cells(51,Lastcolumn).Formula = "=Trim(A1) Because your lastcolumn is variable is numeric you need to use the cells function in the range. The first number is for row number and the second is for the column.
I believe the following will do what you expect it to, the code you used to get the Last Column wasn't right:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("COPY")
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
'get the last Column on Row 1 with data
ws.Range(ws.Cells(51, 1), ws.Cells(51, LastCol)).Formula = "=Trim(A1)"
'add formula from column A to the last Column
End Sub
I am building a calendar in Excel that automatically maps event information from a table to a dynamic calendar view. Each row represents a time from 8AM - 6PM, and each column represents a day of the week from Sunday - Saturday. I was able to map information for each unique event to two separate cells in each column, one for start time and one for end time. I am looking for help with building a macro to merge the cells containing the same information into one so the calendar is cohesive. E.g. Event A starts at 9AM and ends at 11AM. There is currently one cell populated at 9AM and one at 11AM, but the cell for 10AM is blank and I'd like to merge the two populated cells from the 9AM cell to 11AM cell. As the populated cells will not always be adjacent, the offset function doesn't seem to work in this case.
Here is the pseudo code I'm trying to accomplish:
For each column in a specified region
loop through each row
if two cells contain identical text
merge those two cells
Here is the little bit of code I've managed to come up with so far. You can tell there are many gaps and probably syntax errors:
Sub MergeCells
Dim cells As String
cells = ActiveSheet.Range("C8:V28,C31:V51,C54:V74,C77:V97,C100:V120")
If ActiveSheet.Range(cells).??? Then
ActiveSheet.Range(cells).Merge
End If
End Sub
Any help would be greatly appreciated!
Before picture
After picture
Okay - this may be overkill, and you may need to tweak, but this was fun to work on.
Sub combine_Same()
Application.DisplayAlerts = False
Dim tableRng As Range
Dim i As Long, k As Long, lastRow As Long
Dim curText As Range, prevText As Range
Dim tableRanges As Variant
tableRanges = Split("b3:e20,C31:V51,C54:V74,C77:V97,C100:V120", ",")
Dim rng As Long
For rng = LBound(tableRanges) To UBound(tableRanges)
Debug.Print "Working with: " & tableRanges(rng)
Set tableRng = Range(tableRanges(rng))
' tableRng.Select
lastRow = tableRng.Rows(tableRng.Rows.Count).Row
For k = tableRng.Columns(1).Column To tableRng.Columns.Count
For i = lastRow To tableRng.Rows(1).Row Step -1
Set curText = Cells(i, k)
Set prevText = curText.End(xlUp)
If curText.Value = prevText.Value And Not IsEmpty(curText) Then
'curText.Select
Range(curText, prevText).Merge
curText.VerticalAlignment = xlCenter
ElseIf curText.Value = curText.Offset(-1, 0).Value And Not IsEmpty(curText) Then
'curText.Select
Range(curText, curText.Offset(-1, 0)).Merge
curText.VerticalAlignment = xlCenter
End If
Next i
Next k
Next rng
Application.DisplayAlerts = True
End Sub
Looking for some help with a VBA function
I have data on two sheets I need to perform an index match on.
The data size will vary every time the compare is run.
I have coded the VBA to call the data and populate both sheets but running the comparison is causing a problem.
I have created the below function, its running without error but not populating the formula in cell starting J2 to end of the J range.
Sub FormulaFill()
Dim strFormulas(1 To 1) As Variant
With ThisWorkbook.Sheets("Export Worksheet")
strFormulas(1) = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range("J:J").FillDown
End With
End Sub
Any help would be greatly appreciated.
W
Image after updated code applied
You were writing the formula to an array variable, not a cell, then you tried to fill the entire column by using J:J. This means it was trying to fill the entire column with the contents of cell J1, the top cell, not J2.
Here is the code with corrections.
Sub FormulaFill()
With ThisWorkbook.Sheets("Export Worksheet")
.Cells(2, 10).Formula = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range(.Cells(2, 10), .Cells(.Cells(.Rows.Count, 9).End(xlUp).Row, 10)).FillDown
End With
End Sub
The .Cells(.Rows.Count, 9).End(XlUp).Row determines the last filled row of column 9 (I) and the code uses that number in the range to use for the autofill of column 10 (J)
It's because you're not filling the cell with the formula.
Sub FormulaFill()
Dim strFormulas(1 To 1) As Variant
With ThisWorkbook.Sheets("Export Worksheet")
strFormulas(1) = "=INDEX('sheet1'!E:E,MATCH('Export Worksheet'!A2,'sheet1'!A:A,0))"
.Range("J1").Forumla = strFormulas(1)
.Range("J:J").FillDown
End With
End Sub
I cant seem to find a solution for my application after endless searching. This is what I want to do:
I have cells in one excel sheet that can contain a mixture of dates and empty cells in one column. I want to then select the cells that have only dates and then copy them to a corresponding column in another sheet. They must be pasted in exactly the same order as in the first sheet because there are titles attached to each row. I do get it right with this code:
'Dim i As Long
'For i = 5 To 25
'If Not IsEmpty(Sheets("RMDA").Range("D" & i)) Then _
Sheets("Overview").Range("D" & i) = Sheets("RMDA").Range("D" & i)
'Next i
However, the dates in the first sheet are being updated on a daily basis and it can be that one title has not been updated (on another day) on the first sheet because the user has not checked it yet. If I leave it blank and If I follow the same procedure then it will "overwrite" the date in the second sheet and make the cell blank, which I do not want. I hope I was clear. Can someone please help me?
Regards
You can accomplish this very easily (and with little code) utilizing Excel's built-in AutoFilter and SpecialCells methods.
With Sheets("RMDA").Range("D4:D25")
.AutoFilter 1, "<>"
Dim cel as Range
For Each cel In .SpecialCells(xlCellTypeVisible)
Sheets("Overview").Range("D" & cel.Row).Value = cel.Value
Next
.AutoFilter
End With
you could try something like. This will give you the non blanks from the range, there may be an easier way... hope it helps
Sub x()
Dim rStart As Excel.Range
Dim rBlanks As Excel.Range
Set rStart = ActiveSheet.Range("d1:d30")
Set rBlanks = rStart.SpecialCells(xlCellTypeBlanks)
Dim rFind As Excel.Range
Dim i As Integer
Dim rNonBlanks As Excel.Range
For i = 1 To rStart.Cells.Count
Set rFind = Intersect(rStart.Cells(i), rBlanks)
If Not rFind Is Nothing Then
If rNonBlanks Is Nothing Then
Set rNonBlanks = rFind
Else
Set rNonBlanks = Union(rNonBlanks, rFind)
End If
End If
Next i
End Sub
Just because a cell is blank does not mean that it is actually empty.
Based on your description of the problem I would guess that the cells are not actually empty and that is why blank cells are being copied into the second sheet.
Rather than using the "IsEmpty" function I would count the length of the cell and only copy those which have a length greater than zero
Dim i As Long
For i = 5 To 25
If Len(Trim((Sheets("RMDA").Range("A" & i)))) > 0 Then _
Sheets("Overview").Range("D" & i) = Sheets("RMDA").Range("D" & i)
Next i
Trim removes all spaces from the cell and then Len counts the length of the string in the cell. If this value is greater than zero it is not a blank cell and therefore should be copied.
I am creating a report in Excel and I would like VBA to format the row height based upon the value in column K. For example, if cell K17 = 11.25, I want row 17 to be 11.25. Cell k18 = 21.75 so row 18 =21.75.
I need vba to change every row from 17-400.
This should be relatively simple but I can't seem to come up with the correct coding.
Since this is an easy one, I went ahead and provided the answer for you:
Sub RowHeight()
Dim ws as Worksheet
Set ws = Sheets("mySheet") 'replace with your sheet name
Dim rCell as Range
For each rCell in ws.Range("K17:K400")
rCell.EntireRow.RowHeight = rCell.Value
Next
End Sub