I'm looking for a way to have extra cells added to a table, in a sheet with multiple tables. Table A (Column B to F) should get an extra row, under the selected cell. Table B, (Column H to J) should be Fixed: When i add extra cells to row 8 in Table A, Table B should not change. I can only find the EntireRow.Insert, but not for specific cells.
My code so far:
Sub Button1_Click()
Dim anyR As Range
Set anyR = Selection.SpecialCells(xlVisible)
Selection.SpecialCells(xlVisible).Offset(1, 0).EntireRow.Insert
anyR.Offset(1, 0).Select
End Sub
But it adds cells to Table B as well. Thanx for having a look into this!
The following will add a cell beneath the current selection:
Selection.Offset(1, 0).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.SpecialCells(xlVisible).Offset(1, 0).EntireRow.Insert
You're inserting a row in the worksheet - that's like right-clicking the row heading and then selecting "insert".
If you have two tables on the same sheet, with rows at the insertion point, then yeah, both tables will earn an extra row.
If you want to add rows to one table, then work with the table instead of Selection (you hardly ever really need to work with Selection anyway):
Dim table1 As ListObject
Set table1 = Worksheeets("MyAwesomeSheet").ListObjects(1)
table1.ListRows.Add Position:=5, AlwaysInsert:=True
That will insert a new row in the first table of MyAwesomeSheet, making a blank 5th row in that table.
Note that this assumes "table" in the OP is referring to actual tables in the spreadsheet, i.e. that the target sheet has ListObject objects to play with.
I found a way:
Range("A" & ActiveCell.Row & ":L" & ActiveCell.Row).Select
Selection.Copy
Selection.Offset(1, 0).Insert Shift:=xlDown
Range("A" & ActiveCell.Row & ":L" & ActiveCell.Row).Offset(1, 0).ClearContents
ActiveCell.Offset(1, 0).Select
In this case, column A to L are selected.
Thanks for helping!
KR, freek
Related
I want to automatically create a list with VBA.
In an existing table I want to copy a few rows (but not all columns) according to criteria and paste them into a new sheet. These rows should be sorted by a column from smallest to largest value. I started with the code but don't know how to proceed can someone help me.
Thanks!
Sub copy()
Dim variable As String
variable = [A1]
With Sheets(variable).UsedRange
.AutoFilter Field:=10, Criteria1:="PS.SL"; criteria2:="PS.SD"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
End With
Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Sheets(variable).UsedRange.AuotFilter
End Sub
I'm trying to create a macro to copy cells down an entire column of a table in hopes of acting as a 'refresh' in case those formulas were altered or replaced.
I have multiple tables in the same sheet so I can't select the table name because they constantly change.
What I'm thinking of is having a bottom row with a keyword that VBA can select down until they hit the keyword and select those cells to copy the formulas down.
The thing is that I have multiple tables and they would all have the bottom row of keywords.
When I recorded a macro, I have to Control+Shift+Down multiple times to account for missing rows which I imagine wouldn't always be the case. This is what scares me for this macro since sometimes a table would have no missing data so the xlDown function would select more data than it should.
Here is what I recorded:
Sub Macro9()
'
' Macro9 Macro
'
'
ActiveCell.Offset(3, 2).Range("A1").Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
End Sub
Here is an example of the column I am trying to restore formulas on:
I want the formula below "Total Price" to fill down until it hits the word "Total". Note that formulas are hidden if there is no data elsewhere in the sheet.
There are multiple tables on this sheet so this would have to work in different sections of te same sheet.
If you have actual Tables/Listobjects then you could do something like this:
Sub FillDownFormulas()
Dim lo As ListObject, col As Range
For Each lo In ActiveSheet.ListObjects
For Each col In lo.DataBodyRange.Columns
If col.Cells(1).HasFormula Then 'first cell in column has a formula?
col.Formula = col.Cells(1).Formula 'fill formula to rest of column
End If
Next col 'next column
Next lo 'next table
End Sub
One of the most simple ways (for people that usually don't use VBA) is to get the number of the last row in your table. You can do that by counting values in table or with your own code by using a column that is always filled, like:
last_row = Range("B2").end(xldown).row
With last_row value you can fill your formula in ranges, like:
Range("C2").value = 'Your Formula here
Range("C2").AutoFill Destination:=Range("C2:C" & last_row)
You can do that to every column that you want.
I'm very new to VBA and learning through code I find on the internet, and also using macros to see code.
I have an imported xls with three columns of data. I have code that does the following:
Inserts a new column A
Deletes column B
Delete rows with no data
Inserts two columns
So far - okay. What I am then trying to do is insert a number starting at 1 in column A1 and sequentially filling in until all rows with records have a number. I used a macro to see the code, but the range will vary (i.e. there are not always 52 rows in my import).
Is there a way to make this dynamic by only applying a number where there is data in the row (Column B will always have data)?
Thanks in advance - all help greatly appreciated!
Sub DeleteBlankRows()
Dim x As Long
Dim lastRow As Long
Dim A As Long
' INSERT A NEW COLUMN A FOR NUMERICAL SEQUENCE
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'DELETE ALL BLANK ROWS
With ActiveSheet
For x = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If WorksheetFunction.CountA(.Rows(x)) = 0 Then
ActiveSheet.Rows(x).Delete
End If
Next
End With
'add two new columns for population
ActiveCell.Offset(0, 2).Columns("A:A").EntireColumn.Select
Selection.Delete Shift:=xlToLeft
ActiveCell.Columns("A:B").EntireColumn.Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.NumberFormat = "#"
'code to enter a sequential number starting at 1 for every row that has a record
ActiveSheet.Range("A1").Select
ActiveCell.Select
ActiveCell.FormulaR1C1 = "1"
ActiveCell.Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A52"), Type:= _
xlFillSeries
ActiveCell.Range("A1:A52").Select
ActiveWindow.SmallScroll Down:=15
End Sub
There are a lot of stuff to improve your my code, but this should get you started
Some things to begin:
Use option explicit at the top of your modules so you don't have unexpected behavior with undefined variables
Always indent your code (see www.rubberduckvba.com a free tool that helps you with that)
Try to separate your logic defining variables and the reusing them
Name your variables to something meaningful and easy to unterstand (avoid x or r)
Write the code steps in plain English first, then develop it in VBA
Check the code's comments, and adapt it to fit your needs
Code
Public Sub PrepareFormat()
' Set a target sheet
Dim targetSheet As Worksheet
Set targetSheet = ActiveSheet ' This could be always the same sheet. If so, replace activesheet with thisworkbook.Sheets("NameOfTheSheet")
' Insert a new column for numerical sequence
targetSheet.Columns("A:A").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
' Delete all blank rows
Dim counter As Long
With targetSheet
For counter = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If WorksheetFunction.CountA(.Rows(counter)) = 0 Then
.Rows(counter).Delete
End If
Next counter
End With
' Add two new columns for population (this next lines would make column B empty, so filling sequentally would not work below
'targetSheet.Columns("D:D").Delete shift:=xlToLeft
'targetSheet.Columns("A:B").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'targetSheet.Columns("A:B").CurrentRegion.NumberFormat = "#" -> commented this line because cells are going to be empty. What do you want to format as text? maybe this could go after you add the numbers. Also formatting the whole column is a waste of resources
' Insert a number starting at 1 in column A1 (added number 2 to fill down in sequence)
targetSheet.Range("A1").Value = 1
targetSheet.Range("A2").Value = 2
' Sequentially fill in until all rows with records have a number (this doesn't take into account if there are gaps in column b)
Dim referenceRange As Range
Set referenceRange = targetSheet.Range("B1:B" & targetSheet.Range("B" & targetSheet.Rows.Count).End(xlUp).Row)
targetSheet.Range("A1:A2").AutoFill Destination:=referenceRange.Offset(0, -1)
End Sub
Let me know if it works
PS. Check Sidar's answer on how to properly delete empty rows: https://stackoverflow.com/a/9379968/1521579
Could you try this?
'code to enter a sequential number starting at 1 for every row that has a record
'remove your code from here on and substitute with the following
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
ActiveSheet.Range("A1").Select
With ActiveCell
.FormulaR1C1 = "1"
.AutoFill Destination:=ActiveCell.Range("A1:A" & LastRow), Type:=xlFillSeries
End With
I’m trying to create VBA that allows me to copy the one of a cell and paste over until end of the row in the same column.
But I’m unable to figure out how this works, I have a total of 109 rows with 20 columns and in column “BD” that is an empty column and I want to put today date and fill up rest of the same column until end of row.
Please see the code at the bottom
Sub CopyInsert()
Range("BD2").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("BD2").Select
Selection.Copy
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveSheet.Paste
End Sub
This code is working fine but I’m not getting the right result what these codes do is copy and paste over pass 109 rows mean is paste over up to around 2000 rows
My question is how can I copy and paste over until the end of the row like till row 109! If we have over 200 rows, how to copy and paste until end of the row, row 200 in one column! But not using (BD2:BD), I have tried (BD2:BD) and is paste over 109 rows is not stopped at the end of row.
many thanks.
So you need to find the lastRow based on the column where the actual data is...
Try something like this:
With worksheets("mySheet")
Dim lastRow as Long
lastRow = .Cells(.Rows.Count,1).End(xlUp).Row 'this uses column A for example
.Range("BD2:BD" & lastRow).Formula = "=TODAY()"
End With
I am trying to produce some code that will use the AutoFill Down function. I would like to fill Column B with the typical 1,2,3,4, etc. as long as there is text/values in the respective rows of Column A. Right now, my code is hardwired to fill down to cell B50 no matter what, but I don't want it to paste that far down if Column A only has data through cell A7, for example. Ideally, I would like to use the following variable -- rownum = Range("A1").End(xlDown).Row -- to count the number of cells in Column A that have text/values, and use that to replace "B50" in the row designation below. Just not sure of the appropriate syntax to make that happen. Here is the code I have so far.
ActiveCell.FormulaR1C1 = "1"
Range("B2").Select
ActiveCell.FormulaR1C1 = "2"
Range("A1").Select
Range("B1:B2").Select
Selection.AutoFill Destination:=Range("B1:B50"), Type:=xlFillDefault
Thanks in advance to anyone who helps me out! I am a new user of both Macros and VBA Code, and the amount of knowledge that so many of you have amazes me!
Econ
You're much better off if you don't select anything in your code. If you just want to number the rows in column B based on the contents of column A, this will do the trick:
Sub NumberColumn()
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
' get the last row from column A that has a value
lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
' use the last row to determine how far down to extend the formula
ws.Range("B1:B" & lastRow).Formula = "=row()"
End Sub
Pretty simple option to use without the need for a string:
Selection.AutoFill Destination:=Range("A2:A" & Cells(Rows.Count, "B").End(xlUp).Row)
Same goes for copying the number of rows in a column:
Range("A2:A" & Cells(Rows.Count, "B").End(xlUp).Row).Select
Selection.Copy