I have two problems:
1)
I am running a for loop in vba that will search rows for a specific condition. If that condition is met, it will copy the value of a cell from the row above (using the offset function) and paste it in the cell below.
Then I want it to delete the entire row above. I am having trouble combining the offset function with
entirerow.delete
The error i get is just "Syntax error"
Here is the code:
Sub rowdelete()
maxrow = ActiveSheet.UsedRange.Rows.Count
For Each rcell In Range("A2:A" & maxrow)
If rcell.Value = "--" Then
rcell.offset(-1,).EntireRow.Delete
End If
Next rcell
End Sub
2) In playing around with syntax to troubleshoot, i tried just running
rcell.entirerow.delete
this worked, but I realized if there are two adjacent rows which should be both deleted, only the first will be deleted. I presume this is because the second row becomes the first row after deletion and is skipped as an iteration in the loop.
Are there easy ways to get around this? It is important that the rows preserve the sort order they are in before the loop starts.
Thanks!
Use a standard for loop that loops backwards.
Sub rowdelete()
dim maxrow as long
dim i as long
maxrow = ActiveSheet.UsedRange.Rows.Count
For i = maxrow To 2 Step -1
If Cells(i, 1).Value = "--" Then
Rows(i - 1).Delete
End If
Next i
End Sub
another method is to put all the rows into one range and delete it once:
Sub rowdelete()
Dim maxrow As Long
Dim i As Long
Dim rng As Range
maxrow = ActiveSheet.UsedRange.Rows.Count
For i = maxrow To 2 Step -1
If Cells(i, 1).Value = "--" Then
Set rng = Union(rng, Rows(i - 1))
End If
Next i
rng.Delete xlShiftUp
End Sub
Related
This macro is designed to compare the data in column C and D and if C does not match D in a certain row, it deletes the entire tow. The problem is that it deletes the headers in Row 1 on the Excel sheet because they don't match. How do I run the macro for rows 2 through 9999 instead of all 9999 rows.
Sub deleteNonMatchingRows()
Dim i As Long
For i = 9999 To 1 Step -1 ' it will scan 9999 rows of the sheet. This number can be increased for larger sheets
If Range("C" & i) <> Range("D" & i) Then
Range("C" & i).EntireRow.Delete
End If
Next
End Sub
If you use a descriptive variable naming, eg. rename i into iRow you will never forget that this is your row counter, that is counting from row 9999 to row 1 in For iRow = 9999 To 1 Step -1. So you need to change the 1 into a 2 to omit the first row.
I recommend to use a dynamic start for your loop that automatically finds the last used row. This prevents unnecessary loop steps and you don't need to increase it for larger worksheets.
Option Explicit
Public Sub DeleteNonMatchingRows()
Dim LastRow As Long
LastRow = Cells(Rows.Count, "C").End(xlUp).Row 'find last used row in column C
Dim iRow As Long
For iRow = LastRow To 2 Step -1
If Range("C" & iRow) <> Range("D" & iRow) Then
'Range("C" & iRow).EntireRow.Delete
Rows(iRow).Delete 'directy delete a row
End If
Next iRow
End Sub
Deletion of a row is an operation that takes quite some time. Thus, it is a good idea to make all deletions at once, uniting all rows to be deleted in a specific range wholeRange:
Option Explicit
Public Sub DeleteNonMatchingRows()
Dim LastRow As Long
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
Dim wholeRange As Range
Dim iRow As Long
For iRow = LastRow To 2 Step -1
If Range("C" & iRow) <> Range("D" & iRow) Then
If wholeRange Is Nothing Then
Set wholeRange = Rows(iRow)
Else
Set wholeRange = Union(wholeRange, Rows(iRow))
End If
End If
Next iRow
If Not wholeRange Is Nothing Then
wholeRange.Select 'delete this row
Stop 'delete this row
wholeRange.Delete
End If
End Sub
Once you run the code, it will stop on the Stop line. You will be able to see the range, which is to be deleted. The range will be selected. Once you see it, it is a good idea to delete the two rows, mentioned in the comments, you are not going to need them any more.
you can avoid loops:
Sub deleteNonMatchingRows()
With Range("C2", Cells(Rows.Count, "C").End(xlUp)) ' reference column C cells from row 2 doen to last not empty one
With .Offset(, .Parent.UsedRange.Columns.Count) ' reference referenced range offset by active sheet used range columnns (to be sure you'r not overwriting already filled cells)
.FormulaR1C1 = "=IF(RC3<>RC4,1,"""")" ' have referenced cells show a "1" if corresponding cells in column C and D match
.SpecialCells(xlCellTypeFormulas, xlNumbers).EntireRow.Delete ' delete all rows whose referenced column formula result is a number
.ClearContents ' clear referenced range
End With
End With
End Sub
I am attempting to use VBA to fill all blank cells in rows with the value to the left, with the exception that I only want to fill the blank cells between the first and last value in the row (not including row 1 and column A, which are identifiers).
I've struggled with getting the loop to stop once the last column with a value has been reached (as this changes with each row), rather than running all the way through the last column on the sheet.
Originally this was marked as duplicate (Autofill when there are blank values), but this does not solve the mentioned problem. This continues until the sheet ends. As seen in the picture below, the fill should stop when the last value is reached.
I am searching for a solution that will allow me to do this for an entire sheet at once, even though the data ends in different columns throughout the sheet. There are 1000+ rows, so running for each row could be quite tedious.
I've been using this code to fill the data (excluding the 1st row and column). But this is where I am not sure how to get it to stop at the last value in the row.
Sub test()
With ThisWorkbook.Sheets("Sheet1").Range("A:A")
With Range(.Cells(2, 2), .Cells(.Rows.Count, 36).End(xlUp))
With .Offset(0, 1)
.Value = .Value
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]&"""""
On Error GoTo 0
.Value = .Value
End With
End With
End With
End Sub
If my explanation was not clear, This is a sample and the output I am trying to create
Thank you all so much in advance for all your help!
You may try something like this...
Sub FillBlanks()
Dim r As Long, lr As Long, lc As Long
Dim cell As Range, FirstCell As Range, LastCell As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(2, Columns.Count).End(xlToLeft).Column
For r = 3 To lr
Set FirstCell = Range(Cells(r, 1), Cells(r, lc)).Find(what:="*", after:=Cells(r, 1))
If Not FirstCell Is Nothing And FirstCell.Column > 1 Then
Set LastCell = Cells(r, Columns.Count).End(xlToLeft)
Range(FirstCell, LastCell).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
Range(FirstCell, LastCell).Value = Range(FirstCell, LastCell).Value
End If
Next r
End Sub
And here is yet another solution (just to give you some variety):
Option Explicit
Sub fillInTheBlanks()
Dim lngRow As Long
Dim ws As Worksheet
Dim lngColumn As Long
Dim bolStart As Boolean
Dim lngLastColumn As Long
Dim dblTempValue As Double
Dim arrSheetCopy As Variant
Set ws = ThisWorkbook.Worksheets("Sheet1")
arrSheetCopy = ws.Range(ws.Cells(3, 1), ws.Cells(ws.Cells(ws.Rows.Count, "A").End(xlUp).Row, ws.UsedRange.Columns.Count)).Value2
For lngRow = LBound(arrSheetCopy, 1) To UBound(arrSheetCopy, 1)
bolStart = False
lngLastColumn = 0
For lngColumn = LBound(arrSheetCopy, 2) To UBound(arrSheetCopy, 2)
If Not arrSheetCopy(lngRow, lngColumn) = vbEmpty Then lngLastColumn = lngColumn
Next lngColumn
For lngColumn = LBound(arrSheetCopy, 2) To lngLastColumn
If arrSheetCopy(lngRow, lngColumn) = vbEmpty And bolStart Then
arrSheetCopy(lngRow, lngColumn) = dblTempValue
Else
If Not arrSheetCopy(lngRow, lngColumn) = vbEmpty And IsNumeric(arrSheetCopy(lngRow, lngColumn)) Then
bolStart = True
dblTempValue = CDbl(arrSheetCopy(lngRow, lngColumn))
End If
End If
Next lngColumn
Next lngRow
ws.Range("A3").Resize(UBound(arrSheetCopy, 1), UBound(arrSheetCopy, 2)).Value2 = arrSheetCopy
End Sub
This one is probably the fastest solution (even though it seems a bit bulky with much more lines of code when compared to the other solutions). That's due to the fact that this solution is doing most of the work in memory and not on the sheet. The entire sheet is loaded into a variable and then the work is done on the variable before the result (the variable) is written back to the sheet. So, if you have a speed problem then you might want to consider using this solution.
Here is one possible that meets your sample data's expectations.
Sub wqewqwew()
Dim i As Long, fc As Variant, lc As Long
'necessary if you do not want to confirm numbers and blanks in any row
On Error Resume Next
With ThisWorkbook.Worksheets("Sheet6")
For i = 3 To .Cells(.Rows.Count, "A").End(xlUp).Row
If CBool(Application.Count(Rows(i))) Then
fc = Intersect(.Rows(i), .UsedRange).Offset(0, 1).SpecialCells(xlCellTypeConstants, xlNumbers).Cells(1).Column
If Not IsError(fc) Then
lc = Application.Match(9 ^ 99, .Rows(i))
On Error Resume Next
With .Range(.Cells(i, fc), .Cells(i, lc))
.SpecialCells(xlCellTypeBlanks).Cells.FormulaR1C1 = "=RC[-1]"
.Value = .Value2
End With
End If
End If
Next i
End With
End Sub
Just another solution:
The following code can help is there you need to auto-fill the previous values between 1st and last cells depending on value of 1st cell as mentioned in question Excel - VBA fill in cells between 1st and Last value
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
For i = 2 To Target.Column
If Cells(Target.Row, i) = "" Then
If Cells(Target.Row, i - 1) <> "" Then
Range(Cells(Target.Row, i), Cells(Target.Row, i)).Value = Range(Cells(Target.Row, i - 1), Cells(Target.Row, i - 1)).Value
End If
End If
Next i
End Sub
This sub is activated by clicking on any cell. Same cell marks the end of the loop i.e. to stop the loop just click the cell till which you want to fill the blank cells.
I'm looking to create a macro that deletes all rows that don't contain any data in Column B. Any help would be appreciated. This is all I got for now.
Sub DeleteAllEmptyBRows()
Dim lr As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
For Each cell In Range("B1:B" & lr)
If cell.Value = "" Then
cell.Row.Delete
Exit Sub
End If
Next cell
End Sub
You can use SpecialCells to do this in one quick line:
Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
I'd use the above, but also for your own knowledge, here's how you could do it following your code:
Sub DeleteAllEmptyBRows()
Dim lr As Long, i&
lr = Cells(Rows.Count, "B").End(xlUp).Row
For i = lr To 1 Step -1 'Since you're deleting rows, start at the end, and work upwards
If Cells(i, 2).Value = "" Then
Cells(i, 2).EntireRow.Delete
End If
Next i
End Sub
Note that you have an Exit Sub in yours, after the first time a row is deleted. I removed that, since you want to loop through all cells in the range. Again, this is a loop so will take longer, and has more room for errors, than the simple one liner above.
You are missing some parameters:
Cells(cell.Row, 2).Delete Shift:=xlUp
If you need the entire row, just change to:
cell.Row.EntireRow.Delete
I need some help with this macro. I have a workbook that is formatted pretty poorly, but consistently every time I open it. Among other things, the goal is to find the non-blank cells in column B and delete the entire 2 rows below and the 1st row above each of those populated B cells.
The first loop I have in the code works just the way I want it to, but the second loop seems to only work on the 1st instance of a populated B cell, but then it deletes everything else above it, like 500 cells worth of data.
Can someone explain to me why this is happening, and if you could find a way to combine both of those for loops into 1, that would be nice too.
Sub test()
Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long, lastCol As Long
Dim colNames As Variant
Dim i As Integer, j As Integer
Set currentSht = ActiveWorkbook.Sheets(1)
Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For i = lastRow To 1 Step -1
If currentSht.Cells(i, "B").Value <> "" Then
currentSht.Cells(i, "B").Offset(1).EntireRow.Delete
End If
Next i
Range("D3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlUp
currentSht.Rows("1:1").EntireRow.Delete
currentSht.Range("c:d, f:g, i:k").EntireColumn.Delete
currentSht.Range("A:D").Columns.AutoFit
For j = lastRow To 2 Step -1
If currentSht.Cells(j, "B").Value <> "" Then
currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete
End If
Next j
End Sub
Thank you
The second loop deletes everything because upon deletion of the lines above the found value, said value gets moved up and will be found again, triggering another deletion. To fix this, the quickest way would be to skip the next two lines by modifying j:
For j = lastRow To 2 Step -1
If currentSht.Cells(j, "B").Value <> "" Then
currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete
j = j - 2
End If
Next j
It really doesn't matter much if you are looping from top to bottom or vice versa. The only difference would be if there are two entries in column B near each other. In that case, the search order would determine which one is deleted. But is deletion really what you want? Maybe you could .Clear the contents of the rows instead of deleting them.
edit: here's the new code a bit cleaned up
Sub test()
Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long, lastCol As Long
Dim colNames As Variant
Dim i As Integer, j As Integer
Set currentSht = ActiveWorkbook.Sheets(1)
Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For i = lastRow To 1 Step -1
If currentSht.Cells(i, "B").value <> "" Then
'reference the row directly
currentSht.Rows(i + 1).Delete
End If
Next i
'Do not use selection if you can avoid it
Range("D3", Range("D3").End(xlToRight)).Delete Shift:=xlUp
currentSht.Rows(1).Delete
currentSht.Range("C:D, F:G, I:K").Delete
currentSht.Range("A:D").Columns.AutoFit
For j = lastRow To 2 Step -1
If currentSht.Cells(j, "B").value <> "" Then
currentSht.Rows(j - 1).Delete
currentSht.Rows(j - 2).Delete
j = j - 2
End If
Next j
End Sub
If you want to combine the loops the behavior of the macro will change because of the deletions that happen between the loops.
I am very new to VBA and macros in Excel. I have a very large excel spreadsheet in which column A holds dates. I am trying to delete the rows which have a value smaller than a certain date and this is what I have come up with till now..
Sub DELETEDATE()
Dim x As Long
For x = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
Debug.Print Cells(x, "A").Value
If CDate(Cells(x, "A")) < CDate("01/01/2013") Then
Cells(i, "A").EntireRow.Delete
End If
Next x
Next i
End Sub
I am receiving a Next without For error... can somebody help please?
This lends itself well to using the .AutoFilter property of a Range. The script below contains a comment for each step taken:
Option Explicit
Sub DeleteDateWithAutoFilter()
Dim MySheet As Worksheet, MyRange As Range
Dim LastRow As Long, LastCol As Long
'turn off alerts
Application.DisplayAlerts = False
'set references up-front
Set MySheet = ThisWorkbook.Worksheets("Sheet1")
'identify the last row in column A and the last col in row 1
'then assign a range to contain the full data "block"
With MySheet
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
LastCol = .Range("A" & .Columns.Count).End(xlToLeft).Column
Set MyRange = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With
'apply autofilter to the range showing only dates
'older than january 1st, 2013, then deleting
'all the visible rows except the header
With MyRange
.AutoFilter Field:=1, Criteria1:="<1/1/2013"
.SpecialCells(xlCellTypeVisible).Offset(1, 0).Resize(.Rows.Count).Rows.Delete
End With
'turn off autofilter safely
With MySheet
.AutoFilterMode = False
If .FilterMode = True Then
.ShowAllData
End If
End With
'turn alerts back on
Application.DisplayAlerts = True
End Sub
Running this code on a simple example (on "Sheet1" in this picture) that looks like this:
Will delete all rows with a date older than 1/1/2013, giving you this result:
To answer your question
I am receiving a Next without For error
The problem is you are trying to loop on i but you haven't opened a For i loop. When you indent the code below any code that invokes a Loop or condition (i.e. If) it becomes obvious
Sub DELETEDATE()
Dim x As Long
For x = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
Debug.Print Cells(x, "A").Value
If CDate(Cells(x, "A")) < CDate("01/01/2013") Then
Cells(i, "A").EntireRow.Delete 'i has no value so Cells(0, "A") is ??
End If
Next x
Next i 'where is the For i = ... in this code?
End Sub
When writing code I try to:
Enter the end command immediately if it's needed. So type If...Then, hit [ENTER], type End If, hit [HOME], hit [ENTER], hit [UP ARROW] then [TAB] to the right place to write the conditional code so that anyone will be able to read and understand it easily.
Always use Option Explicit at the top of every module to force variable declarations.
a tip about deleting rows based on a condition
If you start at the top and work down, every time you delete a row your counter will effectively move to the cell two rows below the row you deleted because the row immediately below the deleted row moves up (i.e. it is not tested at all).
The most efficient way is to loop up from the bottom or your rows:
Sub DELETEDATE()
Dim x As Long
For x = [a1].SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
Debug.Print Cells(x, "A").Value
If CDate(Cells(x, "A")) < CDate("01/01/2013") Then
Cells(x, "A").EntireRow.Delete 'changed i to x
End If
Next x
End Sub
This way, the next row you want to test has been preserved - you've only moved the row below up by 1 and you've tested that row earlier.
Please try with this
Sub DELETEDATE()
Dim x As Long
last = Range("A65536").End(xlUp).Row
For x = 1 To last
Debug.Print Cells(x, "A").Value
check:
If x <= last Then
If Trim(CDate(Cells(x, "A"))) <= Trim(CDate("7/29/2013")) Then
last = last - 1
Cells(x, "A").EntireRow.Delete
GoTo check
End If
End If
Next x
End Sub
You have an additional Next i for some reason in your code as highlighted by the debugger. Try the below:
Sub DELETEDATE()
Dim x As Long
For x = 1 To Cells.SpecialCells(xlCellTypeLastCell).Row
Debug.Print Cells(x, "A").Value
If CDate(Cells(x, "A")) < CDate("01/01/2013") Then
Cells(i, "A").EntireRow.Delete
End If
Next x
End Sub