I have a macro that opens a workbook. I want it to then look into column C and if it finds anything with the text "Draft", delete the entire row. This is my code which does not appear to give me any errors but it does not delete the rows like I want. What am I missing?
enter code here
Dim i As Long
Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("Archer Search Report")
For i = 2 To FinalRow
If Range("C" & i).Value = "Draft" Then
Rows(i).Delete
End If
Next i
End With
Try this:
Sub DeleteRows()
Dim i As Long, finalRow As Long
finalRow = Cells(Rows.Count, 1).End(xlUp).Row
With Worksheets("Archer Search Report")
For i = finalRow To 2 Step -1
If Range("C" & i).Value = "Draft" Then
Range("C" & i).EntireRow.Delete
End If
Next i
End With
End Sub
Notes:
It's best to work backwards (Step -1) when deleting otherwise it messes with the row count
I prefer EntireRow.Delete
Related
I am trying to match a value from a cell (grid_2.range "A1") and grid_2.range("B1") with a column P on a sheet named grid_2 ("Grid2") to copy all the row where there value is located. Therefore, I will need to check on my data and copy/paste the entire row to another sheet maned grid. But for some reason my code loops but only find the match and copy and paste once.
Sub new_copyPaste()
Dim targetSh As Worksheet
Dim i As Variant
Dim lastRow As Long
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
Position = WorksheetFunction.Match(grid_2.Range("A1"), Worksheets("Grid2").Columns(16), 0)
If grid_2.Cells(i, 16).Value = grid_2.Range("A1") Then
Worksheets("Grid2").Rows(Position).Copy
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
Position = WorksheetFunction.Match(grid_2.Range("B1"), Worksheets("Grid2").Columns(16), 0)
If grid_2.Cells(i, 16).Value = grid_2.Range("B1") Then
Worksheets("Grid2").Rows(Position).Copy
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
End Sub
Maybe do you know what I am doing wrong?
I thought about using VLookup, but after researching, it seems that function match would be more appropriate.
I am open for suggestions :)
Match only returns the first match and is not needed here:
Sub new_copyPaste()
Dim lastRow As Long
Dim i As Long
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
If grid_2.Cells(i, 16).Value = grid_2.Range("A1") Then
Worksheets("Grid2").Rows(i).Copy
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
If grid_2.Cells(i, 16).Value = grid_2.Range("B1") Then
Worksheets("Grid2").Rows(i).Copy
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
End Sub
I have a list of items in column A (starting from A12) I want to know the best way to do this. I want there to be a 7 row gap between all the entries. These entries will have additions so some code that perhaps says if text here then add 7 rows below until no more. Or is there a way to code it so it just pushes the entries into different fields (7+ down). What would the code look like?
Basic adding row is:
Range("A13").EntireRow.Insert
So, along with #Plutian and his code to insert new rows, I edited this to filldown the new rows with data from each cell that is not blank. Hope this helps.
Sub numberf()
Application.ScreenUpdating = False
Dim lastrow As Integer
lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Do While lastrow > 12
Range("A" & lastrow).EntireRow.Resize(7).Insert
lastrow = lastrow - 1
Debug.Print lastrow
Loop
lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Dim i As Long
i = 1
For i = 12 To lastrow Step 8
If Cells(i, 1).Value <> "" Then
Range("A" & i).Resize(8).EntireRow.FillDown
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub numberf()
Application.ScreenUpdating = False
Dim lastrow As Integer
lastrow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
Do While lastrow > 2
Range("A" & lastrow).EntireRow.Resize(7).Insert
lastrow = lastrow - 1
Loop
Application.ScreenUpdating = True
End Sub
As I suggested, a reverse loop that does the trick. Props to #MilesFett with the resize option, as my first idea was to loop 7 times inserting a row. This is much cleaner.
I have excel with 5 different sheets.
sheet3 and sheet4 i want delete rows based on the single column cell value.
in sheet 3 i want to delete rows based on H column cell values if H2="#N/A" and H503="#N/A" then delete entire rows.
in sheet 4 i want to delete rows based on b column cell values if B2="320857876",B3="32085678",B4="12133435" the delete the entire rows where B column cell values starts with 302.
and i want to delete all Data from 'C' column
My excel sheet is like this
Using excel file
Sub Create()
Dim LastRow As Long
Dim i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i) = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
You've got a few requirements there and your code is fairly light but regarding the #N/A part of it, you can't just test for that text using the value approach, which is the default property returned for a range object.
Sub Create()
Dim LastRow As Long, i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i).Text = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
... you need to use .Text to get that to work, or, If IsError(Range("B" & i)) Then is another approach.
The rest of your requirements is just logic. The rest of your code is relatively sound so you just need to work through it.
I hope that helps.
Sub delete_rows()
Dim sheet As Worksheet, cell As Range
Count = 1
For Each sheet In ThisWorkbook.Worksheets
If Count = 3 Then
lastrow = sheet.Cells(sheet.Rows.Count, "H").End(xlUp).Row
Set Rng = sheet.Range("H1:H" & lastrow)
For i = Rng.Cells.Count To 1 Step -1
If Application.WorksheetFunction.IsNA(Rng(i).Value) Then
Rng(i).EntireRow.Delete
ElseIf Rng(i).Value = "#NA" Then
Rng(i).EntireRow.Delete
End If
Next
ElseIf Count = 4 Then
lastrow = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).Row
Set Rng = sheet.Range("B1:B" & lastrow)
Debug.Print (Rng(4).Text)
If Rng(2).Value = "320857876" And Rng(3).Value = "32085678" And Rng(4).Value = "12133435" Then
For i = Rng.Cells.Count To 1 Step -1
If Left(Rng(i).Value, 3) = "302" Then
Rng(i).EntireRow.Delete
End If
Next
End If
lastrow = sheet.Cells(sheet.Rows.Count, "C").End(xlUp).Row
Set Rng = sheet.Range("C1:C" & lastrow)
For Each cell In Rng
cell.Value = ""
Next cell
End If
Count = Count + 1
Next
End Sub
I have been working on a vba which will automatically move an entire row from the Mailing Log worksheet to the Completed Log worksheet if the values "Complete" or "Closed Incomplete" are entered into Column H using a command button in the header of Column H.
The command button is working, but for some strange reason when it pastes the row into the completed log, instead of pasting it onto the next available line, it pastes it right at the bottom of the sheet in row "1048542". also I have only managed to get it working for the value 'Complete' and not yet for Closed Incomplete.
Can someone please help?
I have attached an example of my spreadsheets and my current VBA code Is as below:
Private Sub CommandButton1_Click()
Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("Mailing LOG").UsedRange.Rows.Count
lastrow2 = Worksheets("Completed Log").UsedRange.Rows.Count
If lastrow2 = 1 Then lastrow2 = 0
For r = lastrow To 2 Step -1
If Range("H" & r).Value = "Complete" Then
Rows(r).Cut Destination:=Worksheets("Completed Log").Range("A" & lastrow2 + 1)
lastrow2 = lastrow2 + 1
Else:
End If
Next r
Application.ScreenUpdating = True
End Sub
Spreadsheet
Try this instead. UsedRange doesn't always work as expected as it can include cells previously formatted. I have also added some sheet references to your code to increase clarity (and ensure your code works as expected whichever sheet is active at the time).
Private Sub CommandButton1_Click()
Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("Mailing LOG").UsedRange.Rows.Count
For r = lastrow To 2 Step -1
If Worksheets("Mailing LOG").Range("H" & r).Value = "Complete" Then
Worksheets("Mailing LOG").Rows(r).Cut Destination:=Worksheets("Completed Log").Range("A" & Rows.Count).End(xlUp)(2)
End If
Next r
Application.ScreenUpdating = True
End Sub
I want to hide all RED cells within a worksheet by pressing on a command button. How can I do this by using a Macro? I also want another button to unhide them. Currently I have the following which isn't working:
Sub HideRow()
Dim i As Long
Dim LASTROW As Long
Application.ScreenUpdating = False
LASTROW = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To LASTROW
If Range("C" & i).Interior.ColorIndex = 3 Then
Range("C" & i).EntireRow.Hidden = True
End If
Next i
Application.ScreenUpdating = True
End Sub
Thanks,
Are you sure LASTROW is valid, Maybe you mess up columns?
You search last row by Cells(Rows.Count, 2), 2 means column B.
But you check color in column C Range("C" & i)
BTW you could just use Cells(i,3) instead of Range("C" & i)