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
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 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
My first sheet is set up like this:
I want to find the non zero values in column G. Then I want to read the corresponding name in column C. I, then, want to return the value of the name to a cell on Sheet 2.
At this point, it doesn't matter what cell it returns to in sheet 2. It sounds like a VLOOKUP or INDEXMATCH but my VBA isn't good enough to figure out the formatting of it. This is some code that I tried and I can get it to return the name. But I don't know how to do it for all non zeros or how to have it print to sheet 2. Need a loop or need to figure out look ups!
code:
For Each c In Range("G6").Cells
If c.Value > 0 Then
PlayerName = Range(Cells(Selection.Row, 3).Address).Value
End If
Exit For
Next c
The following code will find the first row which has a number greater than 0 in column G (starting at row 6), and write the value in column C of that row to cell X5 of Sheet2.
With Worksheets("Sheet1")
For Each c In .Range("G6", .Cells(.Rows.Count, "G").End(xlUp)).Cells
If c.Value > 0 Then
Worksheets("Sheet2").Cells(5, "X").Value = c.Offset(0, -4).Value
Exit For ' Moved this inside the `If`, otherwise it will exit as soon as
' the first cell in the range is processed, irrespective of whether
' it was greater than 0 or not
End If
Next c
End With
Iterative version:
Dim s2Row as Long
s2Row = 5
With Worksheets("Sheet1")
For Each c In .Range("G6", .Cells(.Rows.Count, "G").End(xlUp)).Cells
If c.Value > 0 Then
Worksheets("Sheet2").Cells(s2Row, "X").Value = c.Offset(0, -4).Value
s2Row = s2Row + 1
End If
Next c
End With
Here is the logic you'll need. Will you be able to build the macro with this logic? It will help you understand how to maneuver rows that are greater than zero. Then you copy the column on that row y9ou need and paste it to the other sheet.
Sub macro1()
Dim myRng As Range, lastRow As Long
lastRow = ActiveSheet.Range("G65536").End(xlUp).Row
Set myRng = Sheet1.Range("G1:G" & lastRow)
For Each Rng In myRng
If IsNumeric(Rng.Value) And Rng.Value > 0 Then
Debug.Print "Cell " & Rng.Address & " has the number " & Rng.Value & " in row " & Rng.Row
End If
Next Rng
End Sub
Yes, except "G" is a column, not a row. Replace the debug.print line with WorkSheets("sheet name to copy from here").Rows(rng.row).Copy Destination:=WorkSheets("sheet name to copy to here").Range("A" & rowCounterVariable). Of course, change the sheet names to your actual sheet names.
Here I set the first row at 2 on the page to copy to. If you need to set it to the first available row then you need to research how to find the last used row on that page. Put these exact terms into Google "VBA EXCEL HOW TO FIND LAST USED ROW". I have an example of finding the last used row for the activesheet inside the code. We could give you fish today, and teach you how to fish. But you need to catch your own. We're not here to write code for you.
Sub macro2()
Dim myRng As Range, lastRow As Long, rowCounterVariable as long
rowCounterVariable = 2
lastRow = ActiveSheet.Range("G65536").End(xlUp).Row
Set myRng = Sheet1.Range("G1:G" & lastRow)
For Each Rng In myRng
If IsNumeric(Rng.Value) And Rng.Value > 0 Then
WorkSheets("sheet name to copy from here").Rows(rng.row).Copy Destination:=WorkSheets("sheet name to copy to here").Range("A" & rowCounterVariable)
rowCounterVariable = rowCounterVariable + 1
End If
Next Rng
End Sub
I have a problem with my code about delete blank rows. It just has to delete some rows not all blank rows and rows value "0". I don't wanna use .SpecialCells(xlCellTypeBlanks) as some threat on SO forum.
Dim R As Integer
R = Range("CuoiNKC").Row - 1
Dim DelCell As Range
Dim DelRange As Range
Set DelRange = Range("J9:J" & R)
For Each DelCell In DelRange
If DelCell.Value = "0" Or DelCell.Formula = Space(0) Then
DelCell.EntireRow.Delete
End If
Next DelCel
Why don't you use Range AutoFilter Method instead of looping.
Assuming you have the correct value of DelRange in your code, try this:
DelRange.AutoFilter 1, AutoFilter 1, "=0", xlOr, "=" 'filtering 0 and space
DelRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete xlUp 'delete visible cells
ActiveSheet.AutoFilterMode = False 'remove auto filter mode
Btw, if you want to stick with your logic, you need to iterate the rows backward.
You can only do that using the conventional For Next Loop. Again assuming value of R is correct.
For i = R To 9 Step -1
If Range("J" & i).Value = "0" Or Range("J" & i).Value = " " Then
Range("J" & i).EntireRow.Delete xlUp
End If
Next
I am trying to write a macro that will let me copy a range of data from one sheet to another sheet based on a criteria in the column before the column to be copied.
Column B is the criteria column. If there is a 1 in any row in this column then columns C thru AN will be copied from that row where there is a 1 and be pasted into another sheet starting at the top of that sheet.
I have the following code. It locates the first row that satisfies the criteria and copies this row to the second sheet, however the code does not loop thru to find other rows that satisfy the criteria. How can I adjust the code to loop and copy each instance where the criteria is satisfied?
Sub testIt()
Dim i As Integer
Application.ScreenUpdating = False
Sheets("DataDump").Activate
For i = 2 To Range("B2").End(xlDown).Row()
If Range("B" & i).Value = 1 Then
Range("C" & i, "AN" & i).Copy
Sheets("PriceData").Activate
ActiveSheet.Range("B2", "AM2").Select
ActiveSheet.Paste
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub testIt()
Dim i As Long, shtSrc As Worksheet, rngDest As Range
Application.ScreenUpdating = False
Set shtSrc = Sheets("DataDump")
Set rngDest = Sheets("PriceData").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
For i = 2 To shtSrc.Range("B2").End(xlDown).Row
If shtSrc.Range("B" & i).Value = 1 Then
shtSrc.Range("C" & i & ":AN" & i).Copy rngDest
Set rngDest = rngDest.Offset(1, 0)
End If
Next i
Application.ScreenUpdating = True
End Sub