I am trying delete all rows where column B to AD (Lastrow) are blank. On my excel sheet every couple of rows or so column B to AD are blank so i am trying to delete those rows. I have been trying to use the below code:
Sub T()
Dim rng As Range
Set rng = Range("B1:AC10402")
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
No success
Try this code:
Sub DeleteBlankRows()
Dim i As Long
Dim lastRow As Long: lastRow = 10 'here you have to specify last row your table uses
For i = lastRow To 1 Step -1
If Cells(i, Columns.Count).End(xlToLeft).Column = 1 Then
Rows(i).Delete
End If
Next i
End Sub
Little explanation
You specified that you need check for emptiness within row, columns B through AD. This piece of code Cells(i, Columns.Count).End(xlToLeft).Column will return column of the right-most (starting from first column), non-empty cell. If whole row is empty or there's data in first column - it will return 1 - which is misleading, when you are considering A cloumn. But it isn't here, since we consider columns starting with B. So if it returns 1, it means that the row is empty and should be deleted.
this deletes all blank rows in column B
Dim LastRow, i As Integer
LastRow = activesheet.Cells(activesheet.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 1 Step -1
If WorksheetFunction.CountA(Range("B" & i)) = 0 Then
Range("B" & i).EntireRow.Delete
End If
Next i
this deletes all blank rows if column B to column AC is blank
Dim LastRow, i As Integer
LastRow = activesheet.Cells(activesheet.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 1 Step -1
If WorksheetFunction.CountA(Range("B" & i & ":" & "AC" & i)) = 0 Then
Range("B" & i & ":" & "AC" & i).EntireRow.Delete
End If
Next i
Related
I have 5 columns in sheet1, and the same in sheet 2.The name of the product is in A. But sometimes the caracteristics of the products (in B,C,D,E) can change in sheet 2. I want that it actualize the caracteristics in Sheet1.
I tried a Vlookup, but it works only zith one Cell
Sub test()
With Sheets("Feuil1")
.Range("B1").Value = WorksheetFunction.VLookup(.Range("A1").Value, Sheets("Feuil2").Range("A1:B100"), 2, False)
End With
End Sub
Moreover, I cant copy all the line because the colomn F should not change… And products in sheet1 in column A are not tidy and get some duplicates...
You need a loop for this to update each row and you need to update each column as well.
I recommend to use WorksheetFunction.Match instead so you only need to match once per row to get the row number and then you can copy the desired values of that row.
Option Explicit
Public Sub UpdateData()
Dim WsDest As Worksheet 'destination workbook to write in
Set WsDest = ThisWorkbook.Worksheets("Feuil1")
Dim WsSrc As Worksheet 'source workbook to match with
Set WsSrc = ThisWorkbook.Worksheets("Feuil2")
Dim LastRow As Long 'last used row in workbook
LastRow = WsDest.Cells(WsDest.Rows.Count, "A").End(xlUp).Row
Dim iRow As Long, MatchedRow As Long
For iRow = 1 To LastRow 'loop through all rows from row 1 to last used row and update each row
MatchedRow = 0 'initialize
On Error Resume Next 'if no match found then ignore error
MatchedRow = WorksheetFunction.Match(WsDest.Cells(iRow, "A"), WsSrc.Columns("A"), 0) 'get the row number of the match
On Error GoTo 0 'reactivate error reporting
'if it didn't match then MatchedRow is still 0
If MatchedRow > 0 Then 'if a match was found then copy values
WsDest.Cells(iRow, "B").Value = WsSrc.Cells(MatchedRow, "B").Value
WsDest.Cells(iRow, "C").Value = WsSrc.Cells(MatchedRow, "C").Value
WsDest.Cells(iRow, "D").Value = WsSrc.Cells(MatchedRow, "D").Value
WsDest.Cells(iRow, "E").Value = WsSrc.Cells(MatchedRow, "E").Value
Else
'didn't find a match
'you can remove the Else part if you want to do nothing here
End If
Next iRow
End Sub
If the columns you want to copy are continous like B, C, D, E you can do it in one copy action which is faster than 4 copy actions (1 for each column):
WsDest.Range("B" & iRow & ":E" & iRow).Value = WsSrc.Range("B" & MatchedRow & ":E" & MatchedRow).Value
I'm trying to sum a number of columns together in a new column.
I have been able to get to the point where I take A+B and place the values in C. However, the actual columns I will need to sum vary. Is there a way I can edit my code so that any selected columns can be summed in a new column to the right of the selection?
For example. If I select columns B-D, it would insert a new column in E that houses the sums of columns B,C, and D. Or if I selected E-F, it would insert a new column in G that houses the sums of columns E and F.
Sub SumColumns()
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row
For i = 1 To Lastrow
Range("C" & i).Value = Range("A" & i).Value + Range("B" & i).Value
Next i
End Sub
Here is my (rather sloppy) solution:
Sub Test()
Dim col1 As String, col2 As String, lastrow As Long
col1 = Split(Selection.Address, "$")(1)
col2 = Split(Selection.Address, "$")(3)
lastrow = Cells(Rows.Count, col2).End(xlUp).Row
Columns(col2 & ":" & col2).Offset(0, 1).Insert Shift:=xlToRight
For i = 1 To lastrow
Range(col2 & i).Offset(0, 1).Value = WorksheetFunction.Sum(Range(col1 & i & ":" & col2 & i))
Next i
End Sub
I say this is sloppy, because if you have the entire column selected, you won't Split out the column values appropriately. So it depends on how you're trying to do this.
This procedure will let you select any range. It will add a column at the end of the range and sum each row to the new column.
Sub test()
Call InsertSumCol(Sheet1.Range("B2:E4"))
Call InsertSumCol(Sheet2.Range("E1:F3"))
End Sub
Private Sub InsertSumCol(ByVal oRange As Range)
'Add Sum Column to end of Range
oRange.Worksheet.Columns(oRange.Column + oRange.Columns.Count).Insert shift:=xlToRight
' Sum Each Row in Range
Dim oRow As Range
For Each oRow In oRange.Rows
oRow.Cells(1, oRow.Columns.Count + 1) = WorksheetFunction.Sum(oRow)
Next
End Sub
I assume that you want to sum vertically all cells in a row starting from column A.
Try this (some tips and comments are in code):
'use this in order to avoid errors
Option Explicit
Sub SumColumns()
'always declare variables!
Dim LastRow As Long, i As Long, ws As Worksheet, lastCol As Long, firstCol As Long
'if you can, avoid using ActiveSheet, Selection, etc. it's prone to errors
Set ws = ActiveSheet
i = 1
Do
firstCol = ws.Cells(i, 1).End(xlToRight).Column
lastCol = ws.Cells(i, ws.Columns.Count).End(xlToLeft).Column
'there isn't any filled cells in a row
If lastCol = 1 Then Exit Do
ws.Cells(i, lastCol + 1).Value = Application.WorksheetFunction.Sum(ws.Range(ws.Cells(i, firstCol), ws.Cells(i, lastCol)))
i = i + 1
Loop While True
End Sub
Before and after:
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 have a vba code that creates empty row after each row with value:
Row 1
Row 2
Row 3
Output
Row 1
Row 2
Row 3
In the empty rows I want to insert value "check1", "check2", the auto increment of "check" and "autonumber"
To get a final output of the below:
Row 1
check1
row 2
check2
row n
check n
here is the code I have started:
Sub Insert_Blank_Rows()
'Select last row in worksheet.
Selection.End(xlDown).Select
Do Until ActiveCell.Row = 1
'Insert blank row.
ActiveCell.EntireRow.Insert shift:=xlDown
'Move up one row.
ActiveCell.Offset(-1, 0).Select
Loop
End Sub
Here's a quick and easy and efficient way with only minimal adjustment to your current code.
Sub Insert_Blank_Rows()
Dim rng as Range
Set rng = Selection ' grab top most cell in range, you may want to actually refer to the actual cell.
rng.End(xlDown).Select 'Select last row in worksheet.
Do Until ActiveCell.Row = 1
'Insert blank row.
ActiveCell.EntireRow.Insert shift:=xlDown
'Move up one row.
ActiveCell.Offset(-1, 0).Select
Loop
'fill blanks with incremental checks
Dim rngBottom as Range
Set rngBottom = Cells(rows.Count,rng.Column).End(xlUp).Offset(1)
Range(rng, rngBottom).SpecialCells(xlCellTypBlanks).FormulaR1C1 = "=""Check""&ROW()/2"
End Sub
I'll throw in this solution, with no looping nor inserting
it's very fast (less than 1 second for 20k rows)
Option Explicit
Sub main()
Dim helperCol As Range
With ActiveSheet.UsedRange
Set helperCol = .Columns(.Columns.Count + 1)
End With
With Range(ActiveCell, ActiveCell.End(xlDown))
.Offset(, helperCol.Column - .Column).Formula = "=ROW()"
With .Offset(.Rows.Count)
.Formula = "=CONCATENATE(""check"",ROW()-" & .Rows.Count & ")"
.Value = .Value
With .Offset(, helperCol.Column - .Column)
.Formula = "=ROW()-" & .Rows.Count & "+ 0.1"
.Value = .Value
End With
End With
.Resize(2 * .Rows.Count, helperCol.Column - .Column + 1).Sort Key1:=helperCol.Resize(2 * .Rows.Count), Header:=xlNo
helperCol.Resize(2 * .Rows.Count).Clear
End With
End Sub
as per OP's request, it takes move from ActiveCell
So every other row is empty and you want to fill it? One way would be something like
finalRow = cells(1000000,1).end(xlup).row
yourIncrement = 1
for i = 1 to finalRow
if isempty(cells(i,1)) then
cells(i,1) = "check" & yourIncrement
yourIncrement = yourIncrement + 1
end if
next i
I am assuming your want to fill column 1 (A).
How's this?
Sub Insert_Blank_Rows()
Dim lastRow&, i&
'Assuming column A has the most data (if not change the `1` to whatever column # does have the most data
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Select last row in worksheet.
'Selection.End(xlDown).Select ' Don't use `.Select`
i = 2
Do While i <= lastRow
Rows(i).Select
Rows(i).EntireRow.Insert shift:=xlDown
Cells(i, 1).Value = "Check " & Cells(i - 1, 1).Value
Cells(i, 1).Value = Cells(i, 1).Value
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
i = i + 2
Loop
End Sub
Here, I got one for you. I already tested it and work well for requirement.
Which is special in my code? My code will miss no row. Perfect auto-increment.
And I also reference from BruceWayne's code because I don't want to edit his own code.
Sub checkingData()
Dim exeRow As Integer 'For indexing the executing row
Dim lastRow As Integer 'For storing last row
exeRow = 2 'Checking from first row
'Assume that First Column has more data row than Other Column
lastRow = Cells(Rows.Count, 1).End(xlUp).row
'Loop from First Row to Last Row
Do While exeRow <= lastRow + 1
'Select data row
Rows(exeRow).Select
'Insert row below data row
Rows(exeRow).EntireRow.Insert shift:=xlDown
'Set auto-increment result
Cells(exeRow, 1) = "Check " & (exeRow / 2)
'Increase lastRow count because of adding blank row
lastRow = lastRow + 1
'Go to next data row
exeRow = exeRow + 2
Loop
End Sub
Can someone tell me what VB code I can use, to obtain the following macro excel result?
I want for content from column A to be deleted if column B is blank. This is how far I have come:
If Range ("B66")= IsEmpty Then
Range ("A66").Select
Selection.ClearContents
End If
Sub Main()
Application.ScreenUpdating = False
Dim i As Long, r As Range
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
Set r = Range("A" & i)
If IsEmpty(r.Offset(0, 1)) Then r.EntireRow.Delete shift:=xlUp
Next i
Application.ScreenUpdating = True
End Sub
first you need a loop to cycle through all cells in column A
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1 sets up a loop that iterates from the last cell to the first one in column A
Range("A" & Rows.Count).End(xlUp).Row finds the last cell used in column A
Set r = Range("A" & i) sets r variable to be a Range object
If IsEmpty(r.Offset(0, 1)) Then Offset points to cell in column B on the same row, so if it the neighbouring cell of column A (which is cell(sameRow, column B) is empty then
r.EntireRow.Delete shift:=xlUp delete entire row
Application.ScreenUpdating = False/True turn off screen updating to speed up the execution when using loops