I'm trying to insert a row at the bottom of the range, but nothing happens when I run the below code. If I remove the "1" in
Cells(nextRow, 1).EntireRow.Insert
It will insert a row at the top of the range.
Sub newRow()
Application.ScreenUpdating = False
Sheet1.Activate
'goes to the row at the bottom of the range
nextRow = Cells(Rows.Count, 1).End(xlUp).row + 1
'inserts new row
Cells(nextRow, 1).EntireRow.Insert
Application.ScreenUpdating = True
End Sub
Inserting a row at the bottom of the range is not visible - and it is an empty row, which is not different than the unused empty rows. Anyway, inserting a row before the last one of the range is quite visible:
Sub NewRow()
Dim nextRow As Long
With Sheet1
nextRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(nextRow, 1).EntireRow.Insert
End With
End Sub
Usin With Sheet1 and .Cells() instead of Select and Activate is a good practice -How to avoid using Select in Excel VBA
Related
I made a button that adds a new row above another row where the value of the cell in column C is "add row above".
I did it like this because there is a formula on the row below that which totals all of column E.
So when I add a row above C with value add row above it auto updates the formula.
I need to copy a formula from column B into each now. The formula is =ROW(A1) so it numbers the row.
My code to add the new row:
Sub AddRow()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "C").End(xlUp).Row
For i = Lastrow To 1 Step -1
If Cells(i, "C").Value = "Add row above" Then If i > 1 Then Rows(i).Resize(1).Insert xlUp
Next
Application.ScreenUpdating = True
End Sub
Insert Row and Copy Formula
Note that =ROW(A1), =ROW(Z1) or just =ROW() produces the same result.
Option Explicit
Sub AddRow()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "C").End(xlUp).Row
For i = Lastrow To 2 Step -1
If Cells(i, "C").Value = "Add row above" Then
Rows(i).Insert xlShiftDown
Cells(i + 1, "B").Copy Cells(i, "B")
' Or (if below is not numbered):
'Cells(i - 1, "B").Copy Cells(i, "B")
End If
Next
Application.ScreenUpdating = True
End Sub
I find it easier to create a named range and refer to that. This way, if it moves around the sheet, the named range will follow it and you don't have to go looking.
When you do that, this code works quite easily, you just need to adapt it.
Also, the ROW() function doesn't actually need a parameter IF you want to refer to the row that the ROW() formula is on.
Public Sub AddRowAndCopyFormula()
Dim lngAddAtRow As Long
With ThisWorkbook.Names("AddRowAbove")
lngAddAtRow = .RefersToRange.Cells(1, 1).Row
.RefersToRange.Worksheet.Rows(lngAddAtRow).Insert xlShiftDown
.RefersToRange.Worksheet.Range("B" & lngAddAtRow).Formula = "=ROW() - 7"
End With
End Sub
This is what my worksheet looks like.
How can I use VBA to copy data from sheet1 to sheet 2, with a condition that if the value from column G changes, I insert a new row on sheet 2 below the row holding that last value but above the row holding the next value? Sample input is given, with sample output highlighting the inserted row. Getting all the right columns on the output sheet I can do myself, but the logic for the row insert is giving me trouble.
Dim dataSheet As Worksheet
Dim lastRow As Long, r As Long
Set dataSheet = ActiveSheet 'Worksheets("Sheet1")
With dataSheet
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For r = lastRow To 2 Step -1
'compare current row column G to previous row column G, if not the same value, insert row between the two rows
.Rows(r + 1).Resize(UBound + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
Insert Between Groups
Option Explicit
Sub InsertBetweenGroups()
With ActiveSheet.Range("A1").CurrentRegion
Dim rCount As Long: rCount = .Rows.Count
Dim cCount As Long: cCount = .Columns.Count
Dim r As Long
For r = rCount To 2 Step -1
With .Cells(r, "G")
If .Value <> .Offset(1).Value Then
With .Offset(1).EntireRow.Resize(, cCount)
.Insert xlShiftDown, xlFormatFromLeftOrAbove
With .Offset(-1)
.Value = .Offset(-1).Value
.Columns("B").Value = "Data Remote..."
.Columns("G").Value = "Hardware"
.Columns("E:F").ClearContents
.Interior.Color = vbYellow
End With
End With
End If
End With
Next r
End With
End Sub
I have come up with a solution that seems to work for getting the desired output, but it is quite messy compared to #VBasic2008's. I use formulas to fill my empty rows on another sheet; for example:
Worksheets("InvoiceData").Range("V1").Value = "LineDescription"
Worksheets("InvoiceData").Range("V2").Formula2 = "=IF(ISBLANK(A2)=TRUE, ""Hardware"",E2)"
And the VBA to insert the rows:
Sub test()
Dim lRow As Long
'Create InvoiceData sheet to manipulate data
Sheets.Add.Name = "InvoiceData"
'Copy and Paste ABSData sheet as Values
Sheets("ABSData").Cells.Copy
Sheets("InvoiceData").Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
I am new to macro vba I want the macro to add colour yellow to top row i.e. header row and the last column which is blank. The macro should colour the last column which blanks only till where the corresponding rows have data, not the entire column.
below is my code... I get error "error code 1004 application-defined or object-defined"
Private Sub CommandButton8_Click()
'Hide column A to E and color.
ActiveWorkbook.Worksheets("POL").Range("A1", Cells(1, Columns.Count).End(xlToRight)).SpecialCells(xlCellTypeConstants).Interior.ColorIndex = 6
ActiveWorkbook.Worksheets("POL").Columns("A:E").Hidden = True
Application.Wait (Now + TimeValue("0:00:04"))
ActiveWorkbook.Worksheets("POD").Columns("A:E").Hidden = True
End Sub
Excel screen for reference.
The macro should colour top row header and the last column... The last column is blank so it should colour till only where the corresponding row/columns have data.
You could use your used range to get the last row and last column at same time so long as you don't have extra data in the sheet that isn't included in this "table".
Dim lastcell As Range, rng As Range
With ActiveWorkbook.Worksheets("POL")
Set lastcell = .Cells(UsedRange.Rows.Count, UsedRange.Columns.Count)
Set rng = .Range(.Cells(1, lastcell.Column), .Cells(lastcell.Row, lastcell.Column))
End With
rng.Interior.ColorIndex = 6
Update:
Try this one then which finds the last row using the specific column. I set it to use the column before the last one but you can set it to whichever column has the lastrow in it.
Private Sub CommandButton8_Click()
'Hide column A to E and color.
Dim lastcolumn As Long, lastrow As Long
With ActiveWorkbook.Worksheets("POL")
lastcolumn = .Cells(1, Columns.Count).End(xlToLeft).Column
lastrow = .Cells(Rows.Count, lastcolumn - 1).End(xlUp).Row
'lastrow = .range("A" & rows.Count).end(xlup).row 'Use this one if you want to set a specific column to find the last row.
.Range("A1", .Cells(1, lastcolumn)).Interior.ColorIndex = 6
.Range(.Cells(1, lastcolumn), .Cells(lastrow, lastcolumn)).Interior.ColorIndex = 6
End With
ActiveWorkbook.Worksheets("POL").Columns("A:E").Hidden = True
Application.Wait (Now + TimeValue("0:00:04"))
ActiveWorkbook.Worksheets("POD").Columns("A:E").Hidden = True
End Sub
I'm looking for a VBA code to as the title specifies, delete data based on conditions
So I have Column A and Column B, Rows starts from 2 until the end of the sheet, so as an example If the value in B2 is "OK", I would like for the value in A2 to be cleared and then loop the same process until the end of both columns, this is what I have so far but it's not working properly:
Sub Clear()
Dim myLastRow As Long
Dim i As Long
Application.ScreenUpdating = False
Find last row
myLastRow = Cells(Rows.Count, "B").End(xlUp).Row
Loop through range
For i = 2 To myLastRow
If Cells(i, "B").Value = "OK" Then Range(Cells(i, "A")).ClearContents
Next i
Application.ScreenUpdating = True
End Sub
Quick fix for your code is to remove Range
Sub Clear()
Dim myLastRow As Long
Dim i As Long
Application.ScreenUpdating = False
'Find last row
myLastRow = Cells(Rows.Count, "B").End(xlUp).Row
' Loop through range
For i = 2 To myLastRow
' If Cells(i, "B").Value = "OK" Then Range(Cells(i, "A")).ClearContents
If Cells(i, "B").Value = "OK" Then Cells(i, "A").ClearContents
Next i
Application.ScreenUpdating = True
End Sub
Pay attention as Cells refers to the active sheet. In case you would like to run the code on a specific sheet you should better specifiy the sheet.
I have sheet1 with every other cell on column "B" has the following letteres, "LLC". My vba script should clear all "LLC" and horizontally delete entire ROW.
The code I have already used:
Sub deleteRowswithSelectedText()
For Each CELL In Selection
If CELL.Value(i, 2) = "LLC" Then
Rows(CELL.Row).ClearContents
End If
Next
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
End Sub
Try this, If you want to loop through each cell and test it you can, but you will need to loop from the bottom to the top. Another way is to use a filter and delete all the visible rows at the same time.
Dim lr As Long
Dim i As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr - 1 To 2 Step -1
If Cells(i, "B") = "LLC" Then
Cells(i, "B").EntireRow.Delete
End If
Next i
Another way is to use a filter and delete every row that has "LLC" in column B
With ActiveSheet
.AutoFilterMode = False
With Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="LLC"
On Error Resume Next
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
.AutoFilterMode = False
End With
These are just examples, there are many way to accomplish this task.
The code below is probable closer to what you were trying to do.
With Sheets("Sheet1") 'Change to your worksheet name
For Each CELL In .Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
If CELL.Value = "LLC" Then
CELL.EntireRow.Delete
End If
Next CELL
End With