So I have an Excel workbook and I have a button to add new row at the top. The below starts at Row 4 (First data row is row 5). My actual sheet goes out to column L, but the below is just a few of the columns. The header row is highlighted grey. I had trouble with other examples of doing what I needed it to do, so I recorded a macro. Basically it copies the top data row, inserts it, removes highlight, and clears data. This way the lists I have are preserved as well as the cell borders. Is there a more elegant way to do this?
Also, is there a way I can have the Add New Row button generate the UID for me? Note I may sort or filter the data, so I can't just take what's in A5 and add 1.
UID
Requirement
Source
Category
0002
...
...
[list]
0001
...
...
[list]
Private Sub CommandButton1_Click()
Rows("5:5").Select
Selection.Copy
Selection.Insert Shift:=xlDown
Rows("5:5").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B5:L5").Select
Selection.ClearContents
Range("A1").Select
End Sub
Update 1:
New code based on everyone's recommendations. Still would be ideal if I could insert UID when I manually insert a row too.
Private Sub CommandButton1_Click()
Rows(5).Insert xlShiftDown, xlFormatFromRightOrBelow
With Worksheets("Requirements")
NextUID = WorksheetFunction.Max(.Range("A:A")) + 1
End With
Range("A5").Value = NextUID
End Sub
Welcome Scott, get the maximum value of the first column and increment it:
With Worksheets("Sheet1")
NextUID= WorksheetFunction.Max(.Range("A:A"))+1
End With
Related
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
how can I delete hidden (filtered) rows in a table? I tried this. But i guess Excel does not recognize ".SpecialCells(xlCellTypeHidden)"
If ActiveSheet.ListObjects(1).DataBodyRange.SpecialCells(xlCellTypeHidden).Rows.Count >= 1 Then
ActiveSheet.ListObjects(1).DataBodyRange.EntireRow.Delete
Any help will be much appreciated.
Edited with BDra correction
Try this code:
For i = 10 To 1 Step -1
If Rows(i).Hidden Then Rows(i).EntireRow.Delete
Next
Change 10 to your number of rows to check. Note that the least index to Rows() is 1, not 0.
I found that looping is slow and the below proposed looping solution did not work on a table. Again, my earlier question was "How can I delete hidden (filtered) rows in a table? I tried this. But i guess Excel does not recognize ".SpecialCells(xlCellTypeHidden)". So, instead I sort-of reversed the .SpecialCells(xlCellTypeVisible) logic by first coloring the filtered (visible rows) in the table yellow. Then I filtered by color: No Fill. Used .SpecialCells(xlCellTypeVisible) to delete those rows, remove the filter and removed the coloring on the rows that where visible to begin with. Resulting in the hidden (filtered out) rows being deleted. This sub routine deletes hidden rows very quickly.
Sub DeleteHiddenRows()
'Keep all visible rows and remove all other hidden rows in a table
'Optimize Code
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'colors visible rows yellow if visible
If ActiveSheet.ListObjects(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Rows.Count >= 1 Then
ActiveSheet.ListObjects(1).DataBodyRange.Interior.ColorIndex = 6
End If
'reverse filter on non-colored filled cells
ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1, Criteria1:= _
RGB(255, 255, 255), Operator:=xlFilterNoFill
'if data is in a table run this to delete visible - non-colored cells
If ActiveSheet.ListObjects(1).DataBodyRange.SpecialCells(xlCellTypeVisible).Rows.Count >= 1 Then
ActiveSheet.ListObjects(1).DataBodyRange.EntireRow.Delete
End If
ActiveSheet.ShowAllData
'remove cell color in table data body range
With ActiveSheet.ListObjects(1).DataBodyRange.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Turn back on screen updating and Automatic calculation
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
I'm fairly new to VBA and i'm struggling to figure out code to copy and paste certain values to a different worksheet
I've got some code that does work, however it is very slow to run:
If CheckBox1.Value = True Then Sheets("Sheet1").Range("A2:B2").Copy Destination:=Sheets("Sheet2").Range("A2:B2")
If CheckBox2.Value = True Then Sheets("Sheet1").Range("A3:B3").Copy Destination:=Sheets("Sheet2").Range("A3:B3")
If CheckBox3.Value = True Then Sheets("Sheet1").Range("A4:B4").Copy Destination:=Sheets("Sheet2").Range("A4:B4")
...............
If CheckBox53.Value = True Then Sheets("Sheet1").Range("A54:B54").Copy Destination:=Sheets("Sheet2").Range("A54:B54")
I've got each checkbox linked to the cell next to it, e.g E2, E3, E4 etc to display True/False depending on whether is been clicked or not. Also
I'm thinking that a for loop would be better,e.g for "a=2 to 53" and use the true/false values in column E, however i'm unsure how to modify the range of cells within a for loop so that it increases just like "a", so A2:B2, A3:B3 etc
Also, the other problem with this code is that is copies the values to the same cells within the 2nd sheet. What would be the best way to get it to paste the values to the next available row.
If anyone could point out somewhere there's some similar example code that would be extremely useful so that i can learn how to do it myself.
Kind regards
Chris
edit with working code
This is the code that i've come up with to fulfill the criteria outlined above
Sub checkbox()
For i = 2 To 53
Sheets("Sheet1").Select 'activates sheet 1
If Sheets("sheet1").Cells(i, "E").Value = True Then ' checks for true value
Range("A" & i & ":B" & i).Select 'selects range of cells for copying
Selection.Copy
Sheets("Sheet2").Select 'selects sheet 2
Range("A65536").End(xlUp).Offset(1, 0).Select 'selects next available empty row
ActiveSheet.Paste 'pastes value
Else
End If
Next i
End Sub
I have a macro that is supposed to copy the format of a row and insert a new row with the same format.
Here is the macro code:
Sub Insertion_ligne_verrouillée()
'
' Insertion_ligne_verrouillée Macro
ActiveSheet.Unprotect
ActiveCell.Offset(-1, 0).EntireRow.Copy
Rows(ActiveCell.Row).Insert Shift:=xlDown
On Error Resume Next
Rows(ActiveCell.Row).SpecialCells(xlCellTypeConstants).ClearContents
ActiveSheet.Unprotect
'Application.CutCopyMode=False
End Sub
Now i am not the one that wrote the macro and honestly my VBA is quite rusty (also not that good in VBA either). The problem i am having is the user is using the macro by selecting a row and using ctrl+L.
It does copy and insert a row with the right format, however some rows afterward seem empty (all blank and no row number) so you have to select the row > right click > display, for it to display properly
Not sure what to look for
The following code makes a new row below the row you want to copy then copies the format of the row and paste into the new row.
Sub Insertion_ligne_verrouillée()
'Make a new row below active cell
ActiveCell.Offset(1).EntireRow.Insert Shift:=xlDown,
CopyOrigin:=xlFormatFromRightOrAbove
'Copy the active row
ActiveCell.EntireRow.Copy
'paste format into new row
ActiveCell.Offset(1).EntireRow.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End Sub
I have a simple problem I cannot figure out.
Right now I have a macro set up that moves 1 selected row, to the bottom of another worksheet and changes it's color based on good/bad outcome.
I need the cell values and color formatting to be copy/pasted to the other worksheet.
Here's the code I have now
Sub CloseCasePaid()
'
' CloseCasePaid Macro
'
With Selection.Font
.Color = -1003520
.TintAndShade = 0
End With
Selection.EntireRow.Copy Sheets("Closed Files").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Selection.EntireRow.Delete xlShiftUp
End Sub
Thank you for any assistance!
You need to use paste special - values. Here's the syntax:
Range("A1").Copy
Range("B2").PasteSpecial (xlPasteValues)
I would do this before deleting the row, since deleting the row will knock it out of the clipboard.