I have a table which has around 50 columns. Below function works fine. But how can I put a loop across the columns? I cannot write formulas for each column. I cannot use WorksheetFunction.Sum. I require Sum formula to be added in the cell.
Sub Sum_Last_Row()
With Worksheets("Revenue_forecast_table")
Dim LastRow As Long
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("E" & LastRow + 1).Formula = "=SUM(E5:E" & LastRow & ")"
.Range("F" & LastRow + 1).Formula = "=SUM(F5:F" & LastRow & ")"
.Range("G" & LastRow + 1).Formula = "=SUM(G5:G" & LastRow & ")"
.Range("H" & LastRow + 1).Formula = "=SUM(H5:H" & LastRow & ")"
.Range("I" & LastRow + 1).Formula = "=SUM(I5:I" & LastRow & ")"
.Range("J" & LastRow + 1).Formula = "=SUM(J5:J" & LastRow & ")"
End With
End Sub
You can populate the whole row at once and the formula will auto-adjust:
Sub Sum_Last_Row()
Dim NextRow As Long
With Worksheets("Revenue_forecast_table")
NextRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
.Range("E" & NextRow & ":J" & NextRow).Formula = _
"=SUM(E5:E" & NextRow - 1 & ")"
End With
End Sub
Related
I have a CSV file that contains lots of tables inside of one worksheet. I was writing parts of the code in one procedure to check if it was doing what I expected for each table. The final result I pasted in one single procedure and now I'm getting a Compile Error right in the beginning of the code, in "Sub IP_VBA()", and I have no idea how to solve it, can someone help me?
If I run it part by part, it does what I want, but not when I put all the code together.
Sub IP_VBA()
' Format IP table
Dim LR1 As Long, LR2 As Long, LR3 As Long, LR4 As Long, LR5 As Long
Dim FR1 As Long, FR2 As Long, FR3 As Long, FR4 As Long
Dim Rows As Long, i As Long
Dim Data As Range
'Delete tables 1, 2 and 3
Rows("1:3").EntireRow.Delete
Rows("1:1").Select
Range(Selection, Selection.End(xlDown).Offset(1, 0)).Delete Shift:=xlUp
Rows("1:2").EntireRow.Delete
Columns("A:I").EntireColumn.Delete
'Get necessary data from table 4
LR1 = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
Range("B1:B" & LR1 & "," & "D1:E" & LR1 & "," _
& "G1:O" & LR1).Delete Shift:=xlToLeft
'Delete table 5
Rows(LR1 + 2).Select
Range(Selection, Selection.End(xlDown).Offset(1, 0)).Delete Shift:=xlUp
'Get necessary data from table 6
FR1 = Range("A" & LR1).Offset(2, 0).Row
Rows(FR1).EntireRow.Delete
LR2 = ActiveSheet.Range("A" & FR1).CurrentRegion.Rows.Count + LR1 + 1
Range("A" & FR1 & ":B" & LR2 & "," & "E" & FR1 & ":J" & LR2 & "," & _
"L" & FR1 & ":T" & LR2).Delete Shift:=xlToLeft
'Get necessary data from tables 7 and 8
FR2 = Range("A" & LR2).Offset(2, 0).Row
Rows(FR2).EntireRow.Delete
LR3 = ActiveSheet.Range("A" & FR2).CurrentRegion.Rows.Count + LR2 + 1
FR3 = Range("A" & LR3).Offset(2, 0).Row
Rows(FR3).EntireRow.Delete
LR3 = ActiveSheet.Range("A" & FR3).CurrentRegion.Rows.Count + LR3 + 1
Range("A" & FR2 & ":D" & LR3 & "," & "G" & FR2 & ":L" & LR3 & "," & _
"N" & FR2 & ":V" & LR3).Delete Shift:=xlToLeft
'Delete table 9
FR4 = Range("A" & LR3).Offset(2, 0).Row
LR4 = ActiveSheet.Range("A" & FR4).CurrentRegion.Rows.Count + LR3 + 1
Range("A" & FR4 & ":W" & LR4).Delete Shift:=xlToLeft
'Delete Empty Rows
LR5 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
Set Data = ActiveSheet.Range("A1:C" & LR5)
Rows = Data.Rows.Count
For i = Rows To 1 Step (-1)
If WorksheetFunction.CountA(Data.Rows(i)) = 0 Then Data.Rows(i).Delete
Next
'Rename Columns
Range("A1").Formula = "Part Number"
Range("B1").Formula = "IP Qty"
Range("C1").Formula = "IP Value"
End Sub
You have
Dim Rows As Long
but then
Rows("1:3").EntireRow.Delete
I would not use Rows as a variable name, and also use a specific worksheet qualifier for any and all calls to Rows/Range/Cells/Columns
Dim ws As Worksheet
Set ws = ActiveSheet
ws.Rows("1:3").EntireRow.Delete
'etc
I have a table. I put some data into the row beneath the table with vba(see sub formulas).
Then resize the table to include the newly added data(see ResizeListDyn)
The newly added data is now included in the old table.
But my pivot does not reflect the full new table when i refresh.
I have a pivot with the data source that is targeting this table.
Sub Formulas()
LastRow = WorksheetFunction.Max(Sheets("working").Cells(Rows.Count, "x").End(xlUp).Row)
With Worksheets("working")
.Range("x" & LastRow + 1).Formula = "=X" & LastRow & "+7"
.Range("y" & LastRow + 1).Formula = "=VLOOKUP(X" & LastRow + 1 & ",irworstcase!A:F,6,FALSE)"
.Range("z" & LastRow + 1).Formula = "=VLOOKUP(X" & LastRow + 1 & ",irworstcase!A:E,5,FALSE)"
.Range("aa" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",A$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AA$1,""ScenarioName"",$Y53)"
.Range("ab" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",B$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AB$1,""ScenarioName"",$Y53)"
.Range("ac" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",C$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AC$1,""ScenarioName"",$Y53)"
.Range("ad" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",D$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AD$1,""ScenarioName"",$Y53)"
.Range("ae" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",E$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AE$1,""ScenarioName"",$Y53)"
.Range("af" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",F$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AF$1,""ScenarioName"",$Y53)"
.Range("ag" & LastRow + 1).Formula = "=+GETPIVOTDATA(""sum"",G$1,""businessDate"",$X" & LastRow + 1 & ",""substr"",AG$1,""ScenarioName"",$Y53)"
.Range("ah" & LastRow + 1).Formula = "=VLOOKUP(X" & LastRow + 1 & ",'pv01'!A:C,3,FALSE)"
Call ResizeListDyn
End With
End Sub
Sub ResizeListDyn()
Worksheets("working").Activate
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table1")
tbl.Resize tbl.Range.CurrentRegion
End Sub
Then when I refresh my pivot, it does not include the full new table.
Any ideas as to why?
I would appreciate your help with a macro that can make my life easier.
I have data in this format:
and need to have a macro to transform it in another table like this:
Here is the macro -
Sub perform()
Application.ScreenUpdating = False
Sheets("Sheet2").Range("A2:D50000").ClearContents
Dim rowcount, datacount, lastrow As Integer
rowcount = Sheets("Sheet1").Range("A500000").End(xlUp).Row
datacount = Sheets("Sheet1").Range(Sheets("Sheet1").Range("H5"), Sheets("Sheet1").Range("H5").End(xlToRight)).Count
Sheets("Sheet2").[A2] = "Code"
Sheets("Sheet2").[B2] = "Ref"
Sheets("Sheet2").[C2] = "Amount"
Sheets("Sheet2").[D2] = "Quantity"
For i = 5 To rowcount
lastrow = Sheets("Sheet2").Range("A500000").End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & lastrow & ":A" & lastrow + datacount - 1).Value = Sheets("Sheet1").Range("A" & i).Value
Sheets("Sheet1").Range("H4:L4").Copy
Sheets("Sheet2").Range("B" & lastrow & ":B" & lastrow + datacount - 1).PasteSpecial Transpose:=True
Sheets("Sheet1").Range("H" & i & ":L" & i).Copy
Sheets("Sheet2").Range("C" & lastrow & ":C" & lastrow + datacount - 1).PasteSpecial Transpose:=True
Sheets("Sheet1").Range("G" & i).Copy Sheets("Sheet2").Range("D" & lastrow)
Next i
Application.ScreenUpdating = True
End Sub
I have this code to check duplicates, If it find duplicates (or more) in cell L, is it possible to copy the values from cells in the K column into ONE cell?
Sub check_duplicates()
Dim x As Long
Dim LastRow As Long
Dim rng As String
LastRow = Range("L65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("L2:L" & x), Range("L" & x).Value) > 1 Then
Range("L" & x).Copy
End If
Next x
End Sub
I hope is what you want to do, let me know.
Sub Test()
Dim lastrow As Long
lastrow = Range("L" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
lastrow = Range("L" & Rows.Count).End(xlUp).Row
For j = i + 1 To lastrow
If Range("L" & j).Value = Range("L" & i).Value Then
If Not IsEmpty(Range("K" & i)) Then
Range("K" & i) = Range("K" & i) & "," & " " & Range("L" & j)
Rows(j).EntireRow.Delete
Else
Range("K" & i) = Range("L" & j)
End If
j = j - 1
End If
Next j
Next i
End Sub
I'm trying to use the Sumif function in VBA, however, I'm getting a run-time error. The error started when I tried to add the variable CritLastCol into the formula. If I replace that with an actual cell reference it works. I want to be able to autofill the rows below this and my criteria will change based on the row. In other words my sum range and criteria range are fixed and my criteria is the cell to the left of my activecell (but not one over, it could be 20, 30 columns over).
Sub SumBydimcode()
Dim lastCol As Integer
Dim CritLastCol As String
lastCol = Cells(3 & Columns.Count).End(xlToLeft).Column
lastRow = Range("A" & Rows.Count).End(xlUp).Row
NewLastRow = Range("I" & Rows.Count).End(xlUp).Row
CritLastCol = ActiveCell.End(xlToLeft).Value
ActiveCell.FormulaR1C1 = "=SUMIF(R3C8:R" & lastRow & "C8," & CritLastCol & ",R3C10:R" & lastRow & "C" & lastCol & ")"
ActiveCell.AutoFill Destination:=Range(ActiveCell.Address & ":J" & NewLastRow)
End Sub
You need to surround your CritLastCol variable in quotation marks. To do so in VBA, you use the double-quote twice "". As a result, your code would look like this:
ActiveCell.FormulaR1C1 = "=SUMIF(R3C8:R" & lastRow & "C8,""" & CritLastCol & """,R3C10:R" & lastRow & "C" & lastCol & ")"
Notice the extra double-quotes surrounding CritLastCol
Ok, I figured out a way to do it... Instead of autofill, I used a loop starting at the end of my data and working back up.
Sub SumBydimcode()
Dim lastCol As Integer
Dim CritLastCol As String
lastCol = Cells(3 & Columns.Count).End(xlToLeft).Column
lastRow = Range("A" & Rows.Count).End(xlUp).Row
NewLastRow = Range("I" & Rows.Count).End(xlUp).Row
NewFirstRow = lastRow + 7
S = ActiveCell.Row
If S > NewLastRow - NewFirstRow Then
For S = ActiveCell.Row To NewFirstRow Step -1
CritLastCol = ActiveCell.End(xlToLeft).Value
ActiveCell.FormulaR1C1 = "=SUMIF(R3C8:R" & lastRow & "C8,""" & CritLastCol & """,R3C10:R" & lastRow & "C" & lastCol & ")"
ActiveCell.Offset(-1, 0).Select
Next S
End If
End Sub