I have a report that is automatically pulled that requires Sums to be added at the end of certain columns. The report remains static from Column A-R but the amount of columns as of S can be as few as 1 or go up until 52. The amount of rows are never static. I already know how to find the last row and my sums need to start at column J but when I try to autofill to the right to the last column that contains data (on the same row I have summed J), it spits back an error or doesn't work. Anyone know how to do this? This is what I have for code thus far.
Sub TV_Buysheet()
'
' Macro1 Macro
'
Range("J1").Select
FIRST_ROW = ActiveCell.Row
Selection.End(xlDown).Select
LAST_ROW = ActiveCell.Row
Selection.Offset(2, 0).Select
ActiveCell.FormulaR1C1 = "=SUM(R[" & FIRST_ROW - LAST_ROW - 2 & "]C:R[-2]C)"
Dim lastCol As Long
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
ActiveCell.AutoFill Destination:=Range(ActiveCell, lastCol), Type:=xlFillDefault
End Sub
Just missing the line of code that autofills to the last column...
To find the last column, the following should work
Dim lngLastColumn As Long
lngLastColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range(Activecell, Cells(Activecell.Row, lngLastColumn)).FillRight
Related
I'm new with VBA and I am trying to create a macro for work to make everyone's life easier. My goal is to copy rows (or just copy the data in the first column when the second column is "0") from one worksheet named "Bulk Update" with the condition of column B having the value "0" to the last worksheet, at the bottom of the worksheet after the data. I don't know how to reference the last worksheet name. Here is the code that I made (please don't judge me as I am still new and googling around), which I know is completely wrong...
Public Sub CNPPrevOOS()
Worksheets("Bulk Update").Select
a = Worksheets("Bulk Update").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
If Worksheets("Bulk Update").Cells(i, 2).Value = "0" Then
Selection.Copy
ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count).Range("A1").Value = 100
Range("A30000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
You could try the below code.
The data is being filtered for Column 2 = 0. Only those rows are copied and pasted in the last worksheet
Public Sub CNPPrevOOS()
Worksheets("Bulk Update").Select
a = Worksheets("Bulk Update").Cells(Rows.Count, 1).End(xlUp).Row
'Filters the data where column 2 = 0
ActiveSheet.Range(Cells(1, 1), Cells(a, 2)).AutoFilter Field:=2, Criteria1:="0", Operator:=xlFilterValues
'Select only the filtered cells and copy
Range(Cells(2, 1), Cells(a, 1)).SpecialCells(xlCellTypeVisible).Select
Selection.Copy
ThisWorkbook.Worksheets(ThisWorkbook.Sheets.Count).Select
ActiveSheet.Paste Destination:=Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
End Sub
My sheet contains of cars that are placed at a certain location and need to be checked. This list is made twice a day and sometimes contains of 10 rows, sometimes 14, sometimes 12 etc. Now I would like to cut half of the rows and place it next to the other rows (in this case paste it in cell E). I would like to automate this process so in the VBA should be:
Count number of rows (X)
Cut the rows from X/2 to X
Paste the data in cell E1
I found this function which returns the middle cell. However, I would like to put this together in a sub.
Function Middle(r As Range) As Variant
Dim i As Long, j As Long
If r.Columns.Count > 1 Then
Middle = [#N/A]
Exit Function
End If
i = r.Row
j = r.Rows.Count
Middle = Cells(i + (j - 1) / 2, r.Column).Address
End Function
Sub cutting()
Range("Middle:C" & Range("A" & Rows.Count).End(xlUp).Row).Select
Selection.Cut
Range("E2").Select
ActiveSheet.Paste
Range("A1:C1").Select
Selection.Copy
Range("E1").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Range("E8").Select
End Sub
Before
After
You don't need to select the data to work with it.
Try:
Sub Test()
Dim lLastRow As Long
Dim lCutRow As Long
With ThisWorkbook.Worksheets("Sheet1") 'Change Sheet1 to the name of your sheet.
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'Find last row in column A.
If lLastRow > 1 Then
lCutRow = (lLastRow / 2) + 1
.Range(.Cells(lCutRow, 1), .Cells(lLastRow, 3)).Cut Destination:=.Cells(1, 5) 'Paste to row 1, column 5 (E1).
End If
End With
End Sub
How can I, using the code below, replace "B5" by the "LastCol" so that I can activate the last non-blank cell in a row?
Sub LastColumnInOneRow()
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
End With
Worksheets("WARNINGS").Range("B5").Activate
ActiveCell.Offset(2, 0).Activate
End Sub
Thank you
You could do like this:
Sub LastColumnInOneRow()
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
End With
With Worksheets("WARNINGS")
.Activate
.Cells(5,LastCol).Activate
End With
ActiveCell.Offset(2, 0).Activate
End Sub
The question took me a minute to figure out but try this
Worksheets("WARNINGS").Cells(6, LastCol + 1).Activate
at the end.
Sub LastColumnInOneRow()
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Long
With ActiveSheet
LastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
End With
Worksheets("WARNINGS").Cells(6, LastCol + 1).Activate
End Sub
Excellent! Many thanks. Here is the one I used at the end.
This was a first step towards sorting a pivot table results.
I saved a macro to sort the values but am now getting a "Subscript out of Range" warning when I try to run it. I guess the macro script is using a static range that I need to replace so that it can run to whatever Pivot Table results I may have.
But which line of the macro code do I need to replace?
Sub SortLargestWarningsCount()
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
End With
Worksheets("WARNINGS").Cells(6, LastCol).Activate
ActiveCell.Offset(1, 0).Activate
'Sort from Largest
ActiveSheet.PivotTables("WarningsPivotTable").PivotFields( _
"[Warnings].[Column5].[Column5]").AutoSort xlDescending, _
"[Measures].[Count of Column5]", ActiveSheet.PivotTables("WarningsPivotTable"). _
PivotColumnAxis.PivotLines(12), 1
End Sub
In sheet INPUT, rows of data for week schedule gets inputted. Multiple rows per day is possible. Column A contains the dates of the original week of the schedule. When the complete planning is set in the INPUT sheet (lets say 15 rows by 10 columns of data) a macro can be run which copies the planning to the OUTPUT sheet and creates it for a full year. Therefore I'm coding VBA to copy the block of data and paste it beneath the previous week and update the dates by 7 days.
I'm having difficulties with DateAdd function.
Does anyone know a good solution?
Dim i As Integer
Dim rowCount As Long
Dim columnCount As Long
Sheets("OUTPUT").Select
Sheets("OUTPUT").Cells.Clear
Sheets("INPUT").Select
rowCount = Sheets("INPUT").Range("A6", Sheets("INPUT").Range("A6").End(xlDown)).Rows.Count - 1
columnCount = Sheets("INPUT").Range("A5", Sheets("INPUT").Range("A5").End(xlToRight)).Columns.Count - 1
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("OUTPUT").Select
Range("A1").Select
ActiveSheet.Paste
For i = 1 To 51
Range("A" & Rows.Count).End(xlUp).Select
Range(Selection, Selection.Offset(-rowCount, columnCount)).Copy
Range("A" & Rows.Count).End(xlUp).Select
ActiveCell.Offset(1, 0).PasteSpecial
Range("A" & Rows.Count).End(xlUp).Select
Range(Selection, Selection.Offset(-rowCount, 0)).Value = DateAdd("d", 7, Range(Selection, Selection.Offset(-rowCount, 0)).Value)
Next i
Variable= DateAdd("d", 7, Variable)
I'm not entirely sure what you do with columnCount so this may need to be modified, but I think something like this should get you started
Dim dateVals
Dim destRange as Range
Dim cl as Range
For i = 1 To 51
' initial data
' this gets a range from the last cell in column A, offset by the rowCount variable, and resized based on row/col counters
Set rng = Range("A" & Rows.Count).End(xlUp).Offset(-rowCount).Resize(rowCount,columnCount)
' similar size range beginning in row after 'rng'
Set destRange = rng.Offset(rng.Rows.Count)
' Instead of copying the cells/paste special, just transfer the values directly
' Range(rng, rng.Offset(-rowCount, columnCount)).Copy
destRange.Value = rng.Value
' Add 7 days to each cell value
' I assume you only have date values in column 1
For Each cl in destRange.Columns(1).Cells
cl.Value = DateAdd("d", 7, CDate(cl.Value))
Next
Next i
I have an Excel 2013 worksheet where each column has a header row, and then the word "DIRECT" in some or all of the cells. No other data exists in the columns, just "DIRECT" or blanks. No columns are blank, they all have "DIRECT" at least once.
I'm looking for a macro that does the following:
Adds a new top row
Ignores the original header row, but gets a count of the cells with "DIRECT" in them
Puts that number in the corresponding new top cell for each column
Does the above actions for each column in the worksheet
Works regardless of the last column or row with data (I have to run this on several different-sized worksheets)
I recorded a macro that gets close, but it has two problems:
It adds the COUNTA data out to the last row of the workbook, which isn't needed (the populated columns will be a couple hundred, not thousands)
It references a specific cell range, so could cut off data for sheets with more rows
Sub AddColumnCountsRecorded()
'
' AddColumnCounts Macro
'
'
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[2]C:R[15]C)"
Range("J1").Select
Selection.Copy
Range(Selection, Selection.End(xlToRight)).Select
ActiveSheet.Paste
End Sub
If it helps:
Column "A" can determine the last row where data could be (that's the "username" column", so no blanks there) - although this last row will also change from sheet to sheet.
Row 2 (the header row) can determine the last column where data could be - it has no blank columns; in each column, at least one cell will have the word "DIRECT".
Any advice on editing the existing macro or concocting a new one from scratch would be greatly appreciated!
Thanks!
UPDATE:
Much thanks to Scott, here's what I ended up with - this adds the non-blank cell count to the active worksheet and stops at the last row with data in it. I just call it directly, without the 2nd section of code proposed below:
Sub AddColumnCountsRecorded()
With ActiveSheet
.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Dim lRow As Long, lCol As Long
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, 2), .Cells(1, lCol)).FormulaR1C1 = "=COUNTA(R[2]C:R[" & lRow & "]C)"
End With
End Sub
Give this a shot. I made a separate sub that you can pass the worksheet reference too.
Sub AddColumnCountsRecorded(ws As Worksheet)
With ws
.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Dim lRow As Long, lCol As Long
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, 2), .Cells(1, lCol)).FormulaR1C1 = "=COUNTA(R[2]C:R[" & lRow & "]C)"
End With
End Sub
Call it like this:
Sub ColumnCount()
AddColumnCountsRecorded Worksheets("Sheet1")
End Sub