So I've been searching hard to find why my code hasn't been working, but every time I try, I get a result where nothing is changed. Can someone please tell me what I'm missing? Sorry, I'm a total novice but I'm trying.
Dim Cell As Range
With Sheets(1)
' loop column D until last cell with value (not entire column)
For Each Cell In .Range("D2:D" & .Cells(.Rows.Count, "D").End(xlUp).Row)
If Cell.Value <> 110 Then
Rows(Cell.Row).EntireRow.Delete
End If
Next Cell
End With
Instead of looping, make use of excels inbuilt functions, its cleaner and more concise.
With Sheets(1).UsedRange
.AutoFilter Field:=4, Criteria1:="<>110"
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
if you insist on looping then use the following code:
With Sheets(1).UsedRange
For lrow = .Rows.Count To 2 Step -1
If .Cells(lrow, 4).Value <> 110 Then .Rows(lrow).Delete
Next lrow
End With
Untested, but maybe something like:
Option explicit
Sub DeleteRows()
With thisworkbook.worksheets(1)
' loop column D until last cell with value (not entire column)
Dim lastRow as long
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
Dim rowIndex as long
For rowIndex = lastRow to 2 step -1
If .cells(rowIndex, "D").value2 <> 110 then
.cells(rowIndex, "D").entirerow.delete
End if
Next rowIndex
End With
End sub
If you have a lot of rows, you could use union to build a range consisting of all rows to be deleted, then delete them in one go.
Related
How can I cycle through sheet1 to see if there is data in that cell?
If there is no data then go to the next cell.
If there is data in the next cell paste it into sheet2.
The criteria are:
I cannot use a set range it will change as the data changes in sheet1.
I can keep sheet names a constant such as sheet1 and sheet2.
I found a way using columns and or rows yet that code has a major issue. If there is no starting data in the first cell it will not copy anything in the entire row and or column.
I am posting the code I worked with to check the data in columns but if there is no starting data it will skip the whole row.
Sub CopytoImport()
Dim wb As Workbook
Dim iCol As Long
Dim ws As Worksheet
Sheets("sheet2").Cells.ClearContents
' Loop through the column
For iCol = 1 To 22 ' Call out columns I cannot set this every time it should look threw all cells
With Worksheets("sheet1").Columns(iCol)
' Check tht column is not empty
If .Cells(1, 1).Value = "" Then
'Nothing in this column
'Do nothing
Else
' Copy the coumn to te destination
Range(.Cells(1, 1), .End(xlDown)).Copy _
Destination:=Worksheets("sheet2").Columns(iCol).Cells(1, 1)
End If
End With
Next iCol
ActiveWorkbook.Save
End Sub
Function runcode()
Call CopytoImport
End Function
Cells(1, 1) is just RANGE.("A1") you are only operating on this cell in your code. You would need Cells(1, iCol) to account for what column you are on during your loop.
You might also need a nested loop since you are looping through rows as well. The basic outline of a nested loop is as follows. Note the Cells(1,1) is replaced with the i and j representing what row and what column we are on. This might not be the fastest way to achieve the results you want but it sounds like this is what you are asking for help with. You will also need to define a lastrow (with a + 1 at the end to get the next blank cell) in your Sheet2 for when you paste the data. You would put this right under where the loop starts going through rows. This is so the lastrow of your sheet2 is recalculated each time data is being moved to that sheet. I am not going to re-write your code since you stated it is not complete but here is an example that should help you.
For j = 5 To lastcolumn
For i = 5 To lastrow
Dim lastrow2 As Long
lastrow2 = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
If Worksheets(2).Cells(i, j).Value <> 0 Then
Worksheets(1).Range("C" & lastrow2).Value = Worksheets(2).Cells(i, j).Value
Worksheets(1).Range("B" & lastrow2).Value = Worksheets(2).Cells(2, j).Value
End If
Next i
Next j
To find your lastrow:
dim lastrow as long
lastrow = Range("A" & rows.count).End(xlup).Row ' or whatever column contains the data
To find your last column
Dim lastcolumn As Long
lastcolumn = Worksheets(2).Cells(2, Columns.Count).End(xlToLeft).Column
I wrote some pretty simple VBA (excel macros) code to manage my audio licencing excel experience. The code is supposed to look through the excel sheet in column 3, look for any that have "AMC" in their column, and then copy and paste the row to sheet 2 and continue searching through entire excel document. This code is very simple and worked once right before it stopped working right. It only takes the very last AMC value and puts that on sheet 2 but not the other 5 rows that have AMC in their column 3 value.
Please help! I would appreciate it very much :)
-Jeremy
VBA Code:
Sub CommandButton1_Click()
a = Worksheets("Sheet1").UsedRange.Rows.Count
b = 0
For i = 2 To a
If Worksheets("Sheet1").Cells(i, 3).Value = "AMC" Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet2").Activate
' b = ActiveSheet.UsedRange.Rows.Count
Worksheets("Sheet2").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("Sheet1").Activate
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select
End Sub
This should solve your problem :
If Worksheets("Sheet1").Cells(i, 3).Value = "AMC" Then
Worksheets("Sheet1").Rows(i).Copy
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Cells(b + 1, 1).Select
b = b + 1
ActiveSheet.Paste
Worksheets("Sheet1").Activate
End If
You could use Instr and Union.
Union is very efficient as you store all the qualifying ranges in memory and then write out only once to the sheet. Much less expensive operation than continually writing out to the sheet.
Instr allows you to use vbBinaryCompare which means you are doing a case sensitive match i.e. only AC not ac will be matched on.
The code belows avoids .Activate, which is again an expensive operation that isn't required.
UsedRange means you may be looping many more rows than required. You only want to loop to the last populated row in column C of sheet 1, as that is the column you are testing. Hence, I use .Cells(.Rows.Count, C").End(xlUp).Row to find that last row.
Use Option Explicit - research why! It will make your VBA life soooooo much better.
Code:
Option Explicit
Sub CommandButton1_Click()
Dim lastRow As Long, sSht As Worksheet, tSht As Worksheet, loopRange As Range
Set sSht = ThisWorkbook.Worksheets("Sheet1")
Set tSht = ThisWorkbook.Worksheets("Sheet2")
With sSht
Set loopRange = .Range("C2:C" & .Cells(.Rows.Count, C").End(xlUp).Row)
End With
Dim rng As Range, unionRng As Range
For Each rng In loopRange
If InStr(1, rng.Value, "AC", vbBinaryCompare) > 0 Then
If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, rng)
Else
Set unionRng = rng
End If
End If
Next rng
If Not unionRng Is Nothing Then unionRng.EntireRow.Copy tSht.Cells(1, 1)
End Sub
Below is the current (incomplete) code I'm using which works fine to delete any one given row, but what I really need to do is identify rows which meet certain criteria:
Cell Value in Column L > 90%
OR
Cell Value in Column M > 90%
Then if either of those is true I need to find the Cell Value in same row Column G and delete all rows which contain that same Value in Column G.
Sub sbDelete_Rows_Based_On_Multiple_Criteria()
Dim lRow As Long
Dim iCntr As Long
lRow = Cells(Rows.Count, "G").End(xlUp).Row
For iCntr = lRow To 2 Step -1
If Cells(iCntr, "L") > 0.90 OR Cells(iCntr, "M") > 0.90 Then
Cells(iCntr, "G").EntireRow.Delete
End If
Next iCntr
End Sub
--
What I hope to accomplish in my example would result in the only Serial # which is NOT deleted would be 1910910
thank you in advance for your assistance.
Sub ToDelete()
Dim last_row&
'// NOTE! The code assumes that range:
'// 1) starts in column A
'// 2) ends in column O
last_row = Cells(Rows.Count, "G").End(xlUp).Row
'// Helper column 1
With Range("P2:P" & last_row)
.Formula = "=IF(OR(M2>0.9,L2>0.9),1,0)"
.Value = .Value 'Overwrite formula
End With
'// Helper column 2
With Range("Q2:Q" & last_row)
.Formula = "=IF(SUMIF(G:G,G2,P:P)>0,1,0)"
.Value = .Value 'Overwrite formula
End With
Rows(1).CurrentRegion.AutoFilter Field:=17, Criteria1:=1
Rows("2:" & last_row).EntireRow.Delete
ActiveSheet.AutoFilterMode = False 'Remove filter
Columns("P:Q").Delete 'Remove helper columns
End Sub
In my column A I have cells which consists of formatted dates and general formatting. I want to delete rows which are not dates, and I've made this code, but I have to run it multiple times to get it to delete all the rows which aren't dates.
Code:
Sub del_row_not_date()
Dim rng_A_last As Long
Dim i As Integer
rng_A_last = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Debug.Print rng_A_last
For i = 1 To rng_A_last Step 1
If IsDate(Sheet1.Cells(i, 1)) = False Then
Sheet1.Cells(i, 1).EntireRow.Delete
End If
Next
End Sub
Thanks in advance!
Since rows will
Based on this LINK I found this:
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).
This works :)
Sub del_row_not_date()
Dim rng_A_last As Long
Dim i As Integer
rng_A_last = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Debug.Print rng_A_last
For i = rng_A_last To 1 Step -1
'Debug.Print Cells(i, 1).Value
If IsDate(Sheet1.Cells(i, 1)) = False Then
Sheet1.Cells(i, 1).EntireRow.Delete
End If
Next
End Sub
you could try
Sub del_row_not_date()
With Sheet1
.Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
End With
End Sub
what above deletes all column "A" not-numbers cells entire row
if you have cells with numbers that are not dates then use:
Option Explicit
Sub del_row_not_date()
Dim i As Integer
With Sheet1
For i = .Cells(.Rows.Count, "A").End(xlUp).Row To 1 Step -1 '<--| loop backwards not to loose next row index after deleting the current one
If Not IsDate(.Cells(i, 1)) Then .Cells(i, 1).EntireRow.Delete
Next i
End With
End Sub
I want to delete negative values in a range in excel. I have a code that deletes but not all the values.
I got to know that I should first change the value to numeric type. I have the below code in which I have tried to do so with cDec and Convert.ToInt32 but not successful. I am new to vba, I don't know much about its data types. Your help will be highly appreciable:
Sub Button1_Click()
Dim ws As Worksheet
Dim i As Integer
i = 1
Set ws = Sheets("Recovered_Sheet1")
ws.Activate
Dim r As Excel.Range
For Each r In Range("A1:A250").Rows
If Not IsEmpty(ActiveCell.Value) Then
'move to the row below
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = CDec(ActiveCell.Value)
End If
Next r
Do While Cells(i, 1).Value <> ""
If Cells(i, 1) < 0 Then
Cells(i, 1).EntireRow.Delete
End If
i = i + 1
Loop
End Sub
Here is one way of doing that. Note that when deleting rows, you should work from the bottom up. Also, you don't need to change the Excel data type before running this macro, unless you have some other reason to do so (in which case there are more efficient methods than going cell by cell).
Edit Since text and blanks will return False with .Value < 0, there's no need to test anything else.
Option Explicit
Sub DelNegNumRows()
Dim I As Long
For I = 250 To 1 Step -1
With Cells(I, 1)
If .Value < 0 Then
.EntireRow.Delete
End If
End With
Next I
End Sub
Depending on the characteristics of your range, you may not need to check all 250 rows (although if that is the size of your database, you won't perceive a speed advantage to making the range smaller). For example, if all of your rows with data are non-blank, you can do something like:
lastrow = cells(1,1).end(xldown).row
or, if there might be blanks, and you want to find the last row in column A that has any data, something like:
lastrow = cells(rows.Count,1).end(xlup).row
You could then cycle, in the macro above:
for I = lastrow to 1 step -1
Sub Button1_Click()
Dim I As Long
Dim lastrow As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For I = lastrow To 1 Step -1
With Cells(I, 2)
If .Value < 0 Then
.EntireRow.Delete
End If
End With
Next I
End Sub