I need to add up the total for column L, I know the first and last rows:
lRow = Cells(Rows.Count, 2).End(xlUp).Row
fRow = Cells(lRow, "B").Value
So how do I use lRow and fRow in my SUM?
activecell.Formula = "=SUM(L" & lrow & ":L" & frow & ")"
Edit - Added:
Sub Assign
dim dbl_assign as long
lRow = Cells(Rows.Count, 2).End(xlUp).Row
fRow = Cells(lRow, "B").Value
activecell.Formula = "=SUM(L" & lrow & ":L" & frow & ")"
dbl_assign = activecell.value
end sub
Related
I want to do a dynamic sum formula in VBA and it's some how very difficult for me because I don't use well integer variables.
the last row might change in the future and I need that the range will be dynamic.
thanks to those who will help me.
Sub SumColumns()
Sheets("data").Select
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.Value = "sum"
Selection.Interior.ColorIndex = 33
Selection.Font.Bold = True
Dim LastCol As Integer
Dim LastRow As Integer
With Sheets("data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
Range("A1").End(xlDown).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=SUM(R[- " & LastRow & " + 1]C:R[-1]C)"
Selection.AutoFill Destination:=Range("B" & LastRow, "I" & LastRow), Type:=xlFillDefault
End Sub
that is the line with the error:
ActiveCell.FormulaR1C1 = "=SUM(R[- " & LastRow & " + 1]C:R[-1]C)"
Take the + 1 out of the quotes as that seems to be causing the problem and you need to deduct 1 otherwise you will be on row zero. The code below also removes your selects which are unnecessary and inefficient. And use your LastCol variable to determine across how many columns to copy the formula.
Sub SumColumns()
Dim LastCol As Long 'use Long rather than Integer
Dim LastRow As Long
With Sheets("data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range("A" & LastRow + 1)
.Value = "sum"
.Interior.ColorIndex = 33
.Font.Bold = True
End With
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range("B" & LastRow + 1).Resize(, LastCol - 1).FormulaR1C1 = "=SUM(R[-" & LastRow - 1 & "]C:R[-1]C)"
End With
End Sub
You can get rid of many select portions and steam line code like below. Test it and see if this is what you are after.
Sub SumColumns()
Dim LastCol As Long
Dim LastRow As Long
With Sheets("data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
With .Range("A" & LastRow).Offset(1, 0)
.Value = "SUM"
.Interior.ColorIndex = 33
.Font.Bold = True
End With
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A" & LastRow).Offset(0, 1).FormulaR1C1 = "=SUM(R[-" & LastRow - 1 & "]C:R[-1]C)"
.Range("A" & LastRow).Offset(0, 1).AutoFill Destination:=.Range("B" & LastRow, .Cells(LastRow, LastCol)), Type:=xlFillDefault
.Range("A" & LastRow, .Cells(LastRow, LastCol)).Borders.LineStyle = xlContinuous
.Range("A" & LastRow, .Cells(LastRow, LastCol)).Borders.Weight = xlThin
End With
End Sub
I am working on combining multiple Excel worksheets into a single Master worksheet. The following code works for when all worksheets have identical columns:
Sub CombineData()
Dim Sht As Worksheet
'This If will clear Master before combining
Worksheets("Master").Range("A2:ZZ9000").ClearContents
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "Master" And Sht.Range("A2").Value <> "" Then
Sht.Select
LastRow = Range("A9000").End(xlUp).Row
Range("A2", Cells(LastRow, "ZZ")).Copy
Sheets("Master").Select
Range("A9000").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Else
End If
Next Sht
End Sub
However, I now need to go one step further and merge worksheets when the columns differ from the source worksheets, into a master which has all coluns listed.
This shows the layout of the worksheets I'm testing with, to keep things simple.
I'm open to either mapping all source to destination columns (e.g.
-Source1, Column A to Master, Column A
-Source2, Column B to Master, Column D
-Etc
Or simply recreating Master with all columns from source worksheets - which is preferable in case source worksheets change.
Cheers-
I have made some changes to your code, to make it suitable for mapping any column from master to sheet1. You have to hard code the mapping inside the code
Sub CombineData()
Dim Sht As Worksheet
Dim colname As String
Dim Lastrow As Integer, rowcount As Integer
'This If will clear Master before combining
Worksheets("Master").Range("A2:ZZ9000").ClearContents
colname = 1
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name = "Sheet2" And Sht.Range("A2").Value <> "" Then
Lastrow = Range("A9000").End(xlUp).Row
Sheets("Master").Select
rowcount = Range("A9000").End(xlUp).Row
Sht.Select
'Map the columns of sheet2 to master
Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value
Sheets("Master").Range("B" & rowcount & ":B" & rowcount + Lastrow - 2).Value = Sht.Range("C2:C" & Lastrow).Value
ElseIf Sht.Name = "Sheet3" And Sht.Range("A2").Value <> "" Then
Lastrow = Range("A9000").End(xlUp).Row
Sheets("Master").Select
rowcount = Range("A9000").End(xlUp).Row
Sht.Select
'Map the columns of sheet3 to master
Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value
Sheets("Master").Range("B" & rowcount & ":B" & rowcount + Lastrow - 2).Value = Sht.Range("B2:B" & Lastrow).Value
End If
Next Sht
End Sub
**************Edited********************
Sub CombineData()
Dim Sht As Worksheet
Dim colname As String
Dim Lastrow As Integer, rowcount As Integer
'This If will clear Master before combining
Worksheets("Master").Range("A2:ZZ9000").ClearContents
colname = 1
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name = "Sheet1" And Sht.Range("A2").Value <> "" Then
Sheets("Sheet1").Select
Lastrow = Range("A9000").End(xlUp).Row
Sheets("Master").Select
rowcount = Range("A9000").End(xlUp).Row + 1
Sht.Select
'Map the columns of sheet2 to master
Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value
Sheets("Master").Range("B" & rowcount & ":B" & rowcount + Lastrow - 2).Value = Sht.Range("B2:B" & Lastrow).Value
Sheets("Master").Range("C" & rowcount & ":C" & rowcount + Lastrow - 2).Value = Sht.Range("C2:C" & Lastrow).Value
Sheets("Master").Range("D" & rowcount & ":D" & rowcount + Lastrow - 2).Value = Sht.Range("D2:D" & Lastrow).Value
ElseIf Sht.Name = "Sheet2" And Sht.Range("A2").Value <> "" Then
Sheets("Sheet2").Select
Lastrow = Range("A9000").End(xlUp).Row
Sheets("Master").Select
rowcount = Range("A9000").End(xlUp).Row + 1
Sht.Select
'Map the columns of sheet3 to master
Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value
Sheets("Master").Range("E" & rowcount & ":E" & rowcount + Lastrow - 2).Value = Sht.Range("B2:B" & Lastrow).Value
Sheets("Master").Range("F" & rowcount & ":F" & rowcount + Lastrow - 2).Value = Sht.Range("C2:C" & Lastrow).Value
Sheets("Master").Range("G" & rowcount & ":G" & rowcount + Lastrow - 2).Value = Sht.Range("D2:D" & Lastrow).Value
Sheets("Master").Range("C" & rowcount & ":C" & rowcount + Lastrow - 2).Value = Sht.Range("E2:E" & Lastrow).Value
End If
Next Sht
End Sub
I have a master file which is (JV501) where I filter through column AB (currency) then copy those to createdsheets, my problem now is the lastrow from master file which I need to include to every created worksheets since it starts in column R and from there under column AD (which is all null) lastrow is where I shall perform a subtotal of AC2 up to lastrow so the subtotal shall inline with the lastrow copied.
Option Explicit
Sub SortCurrency()
Dim currRng As Range, dataRng As Range, currCell As Range
Dim LastCol As Long, lastRow As Long, lastrow2 As Long, TheLastRow As Long
Call DeleteSheets
With Worksheets("JV501")
Set currRng = .Range("AB1", .Cells(.Rows.Count, "AB").End(xlUp))
Set dataRng = Intersect(.UsedRange, currRng.EntireRow)
LastCol = Range("A1").End(xlToRight).Column
TheLastRow = Range("A1").End(xlDown).Row
lastRow = Range("AB2").End(xlDown).Row
Range("AB2:AB" & lastRow).sort key1:=Range("AB2" & lastRow), _
order1:=xlAscending, Header:=xlNo
Range("AF:XFD").EntireColumn.Delete
With .UsedRange
With .Resize(1, 1).Offset(, .Columns.Count)
With .Resize(currRng.Rows.Count)
.Value = currRng.Value
.RemoveDuplicates Array(1), Header:=xlYes
For Each currCell In .SpecialCells(xlCellTypeConstants)
currRng.AutoFilter field:=1, Criteria1:=currCell.Value
If Application.WorksheetFunction.Subtotal(103, currRng) - 1 > 0 Then
dataRng.SpecialCells(xlCellTypeVisible).Copy Destination:=GetOrCreateWorksheet(currCell.Value).Range("A1")
Range("J:Q").EntireColumn.Delete
Range("A:A").EntireColumn.Delete
Columns("A:AE").Select
Selection.EntireColumn.AutoFit
End If
Next currCell
.ClearContents
End With
End With
End With
.AutoFilterMode = False
End With
Call checklist
End Sub
Function GetOrCreateWorksheet(shtName As String) As Worksheet
On Error Resume Next
Set GetOrCreateWorksheet = Worksheets(shtName)
If GetOrCreateWorksheet Is Nothing Then
Set GetOrCreateWorksheet = Worksheets.Add(After:=Sheets(Sheets.Count))
GetOrCreateWorksheet.Name = shtName
End If
End Function
this is my code so far. I'm confused if how I shall do this.
Every help is appreciated!
In trying to compute for a a column range i've come up and got it working by adding this in my loop in creating sheets.
'subtotal of debit
lastrowSrc = Range("AC" & Rows.Count).End(xlUp).Row + 1
Range("AC" & lastrowSrc & ":AC" & lastrowSrc).Formula = "=SUBTOTAL(9,AC2:AC" & lastrowSrc - 1 & ")"
'copy ac to ad
Range("AC" & lastrowSrc & ":AC" & lastrowSrc).Cut Destination:=Range("AC" & lastrowSrc).Offset(0, 1)
in column AC is where I will compute the subtotal of debit then copy it to another column which is AD which is null I've pasted it by column AC then offset
For copying the columns not included in criteria of extracting I've done it one by one
dim internalS as long, 'and so on
internalR = Range("R" & Rows.Count).End(xlUp).Row + 1
copyR.Copy Destination:=Range("R" & internalR)
internalS = Range("S" & Rows.Count).End(xlUp).Row + 1
copyS.Copy Destination:=Range("S" & internalS)
internalT = Range("T" & Rows.Count).End(xlUp).Row + 1
copyT.Copy Destination:=Range("T" & internalT)
internalU = Range("U" & Rows.Count).End(xlUp).Row + 1
copyU.Copy Destination:=Range("U" & internalU)
internalV = Range("V" & Rows.Count).End(xlUp).Row + 1
copyV.Copy Destination:=Range("V" & internalV)
internalW = Range("W" & Rows.Count).End(xlUp).Row + 1
copyW.Copy Destination:=Range("W" & internalW)
internalX = Range("X" & Rows.Count).End(xlUp).Row + 1
copyX.Copy Destination:=Range("X" & internalX)
internalY = Range("Y" & Rows.Count).End(xlUp).Row + 1
copyY.Copy Destination:=Range("Y" & internalY)
internalZ = Range("Z" & Rows.Count).End(xlUp).Row + 1
copyZ.Copy Destination:=Range("Z" & internalZ)
internalAE = Range("AE" & Rows.Count).End(xlUp).Row + 1
copyAE.Copy Destination:=Range("AE" & internalAE)
also inserted this in my loop in creating new worksheets
The below code seeks to pull the value from a cell in the the 'Input' sheet, and then display it in the 'Output' sheet. It then shows the difference between the last value recorded and expresses the figure as a percentage.
When I run this code with the Output sheet active it works. However, when I run it from the output sheet it doesn't. Instead, it displays the value I wish to copy in column F in the input sheet and displays the difference and percentage difference in the wrong cells in the Output sheet.
It looks correctly referenced to me, but it obviously isn't. Thoughts on how to correct?
I appreciate that the code could be tidier - i'm very new to this.
Sub Button1_Click()
Dim LastRow As Long
Dim RecentRow As Long
With Sheets("Output")
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
RecentRow = .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Row
Range("F" & LastRow).Select
ActiveCell.Offset(1, 0).Formula = "=Input!B4"
ActiveCell.Offset(1, 0).Copy
ActiveCell.Offset(1, 0).PasteSpecial (xlValues)
End With
ActiveCell.Offset(0, 1).Formula = "=(F" & RecentRow & "-F" & LastRow & ")"
ActiveCell.Offset(0, 2).Formula = "=((F" & RecentRow & "/F" & LastRow & ")-1)"
End Sub
Thanks.
The below code should fix your issue - it's because your Range("F" & LastRow).Select did not have a period before Range.
Sub Button1_Click()
Dim LastRow As Long
Dim RecentRow As Long
With Sheets("Output")
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
RecentRow = .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Row
With .Range("F" & LastRow)
.Offset(1, 0).Formula = "=Input!B4"
.Offset(1, 0).Copy
.Offset(1, 0).PasteSpecial (xlValues)
.Offset(0, 1).Formula = "=(F" & RecentRow & "-F" & LastRow & ")"
.Offset(0, 2).Formula = "=((F" & RecentRow & "/F" & LastRow & ")-1)"
End With
End With
End Sub
Furthermore, you can gain a bit more efficiency in your code with the below:
Sub Button1_Click()
Dim LastRow As Long
With ThisWorkbook.Sheets("Output") 'Allow for code to work even if in another workbook.
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
With .Range("F" & LastRow)
.Offset(1, 0).Value2 = ThisWorkbook.Sheets("Input").Range("B4").Value2
.Offset(0, 1).Formula = "=(F" & LastRow + 1 & "-F" & LastRow & ")"
.Offset(0, 2).Formula = "=((F" & LastRow + 1 & "/F" & LastRow & ")-1)"
End With
End With
End Sub
I have a table as shown below.
In column C I would like to Sum values from column A if they have the same index (column B). I would like to put sum result for all the rows if they have same index (as shown in column D).
Unfortunately the range of values with same index is variable and my macro can sum values just with 2 indexes. Can anyone help with it, please? Thanks!
Sub example()
Dim ws As Worksheet
Dim LastRow As Long
Dim n, i As Integer
Set ws = ActiveWorkbook.Sheets("Sheet2")
ws.Select
LastRow = Sheets("Sheet2").Range("A" & Sheets("Sheet2").Rows.Count).End(xlUp).Row
Range("C3:C" & LastRow).Select
Selection.ClearContents
For i = 3 To LastRow
If Range("B" & i + 1) - Range("B" & i) = 0 Then
Range("C" & i) = Range("A" & i + 1) + Range("A" & i)
Else
Range("C" & i) = Range("C" & i - 1)
End If
Next i
End Sub
Here's one way:
Sub example()
Dim ws As Worksheet
Dim LastRow As Long
Set ws = ActiveWorkbook.Sheets("Sheet2")
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
With ws.Range("C3:C" & LastRow)
.ClearContents
.Value = ws.Evaluate("INDEX(SUMIF(B3:B" & LastRow & ",B3:B" & LastRow & ",A3:A" & LastRow & "),)")
End With
End Sub