I have a piece of VBA code that sorts through a worksheet and deletes all rows that in which one of the columns does not contain specific values
Sub DeleteRows()
' Defines variables
Dim Cell As Range, cRange As Range, LastRow As Long, x As Long, TestRange As Range, MyRange As Range
' Defines LastRow as the last row of data based on column C
LastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
' Sets check range as E1 to the last row of C
Set cRange = Range("C1:C" & LastRow)
' For each cell in the check range, working from the bottom upwards
For x = cRange.Cells.Count To 1 Step -1
With cRange.Cells(x)
' If the cell does not contain one of the listed values then...
If .Value <> "Location1" And .Value <> "Location2" And .Value <> "Location3" Then
' Delete that row
.EntireRow.Delete
End If
End With
' Check next cell, working upwards
Next x
End Sub
The problem is I have a very long and growing list of locations. Instead of specifying locations (e.g., "Location1", "Location2", etc.), I want the code to compare each cell in the check range against a named list ("ReferenceLocations") and delete the row if the cell contains a location name not in that list.
How can I change that section of code (if .value<>...) to achieve this?
Using Application.Match and IsError:
If IsError(Application.Match(.Value, Range("ReferenceLocations"), 0)) Then
.EntireRow.Delete
End If
This assumes that your named range is a single row or column. If that is not a safe assumption, then:
If Application.CountIfs(Range("ReferenceLocations"), .Value) = 0
.EntireRow.Delete
End If
Related
situation is following:
I have 32 columns with data (various number of rows in columns) and need to delete cells with .value "downloaded" (always last cell in a column).
I have a code looping from column 32 to 1 and searching last_row for "downloaded" value. For 30 columns code seems to be working flawlessly but 2 columns return last_row value 1 even though there are multiple values (in fact hundreds of them) but they are non existent for VBA code.
Code:
Last_Col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
last_row = ws.Cells(Rows.Count & Last_Col).End(xlUp).Row
For R = Last_Col To 1 Step -1
With ws
Last_Col = R
last_row = ws.Cells(.Rows.Count & Last_Col).End(xlUp).Row
If Cells(last_row, Last_Col).Value Like "*Downloaded*" Then
Cells(last_row, Last_Col).ClearContents
End If
End With
Next R
Data is being drained from another worksheets. For 2 columns where I experience an error, I manually deleted values and inserted another, random batch of values and code worked as intended.
Checked columns formatting, worksheets from which data is taken but I struggle to find a solution.
Thank you for your help.
Clear Last Cell If Criteria Is Met
The main mistake was using Cells(.Rows.Count & Last_Col), where .Rows.Count & Last_Col would have resulted in a 8 or 9-digit string, while it should have been ws.Cells(ws.Rows.Count, Last_Col).End(xlUp).Row which was pointed out by chris neilsen in the comments.
Another important issue is using ws. in front of .cells, .rows, .columns, .range, aka qualifying objects. If you don't do it and e.g. the wrong worksheet is active, you may get unexpected results.
There is no need for looping backwards unless you are deleting.
Although it allows wild characters (*, ?), the Like operator is case-sensitive (a<>A) unless you use Option Compare Text.
The first solution, using the End property, will fail if a number of last columns is hidden or if you insert a new first row e.g. for a title.
The second solution, using the Find method (and the first solution), may fail if the data is filtered.
The Code
Option Explicit
Sub clearLastEnd()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastCol As Long
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Dim LastRow As Long
Dim c As Long
For c = 1 To LastCol
LastRow = ws.Cells(ws.Rows.Count, c).End(xlUp).Row
With ws.Cells(LastRow, c)
If InStr(1, .Value, "Downloaded", vbTextCompare) > 0 Then
.ClearContents
End If
End With
Next c
End Sub
Sub clearLastFind()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim cel As Range
Set cel = ws.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
If Not cel Is Nothing Then
Dim c As Long
For c = 1 To cel.Column
Set cel = Nothing
Set cel = ws.Columns(c).Find(What:="*", _
SearchDirection:=xlPrevious)
If Not cel Is Nothing Then
If InStr(1, cel.Value, "Downloaded", vbTextCompare) > 0 Then
cel.ClearContents
Else
' The current last non-empty cell does not contain criteria.
End If
Else
' Column is empty.
End If
Next c
Else
' Worksheet is empty.
End If
End Sub
EDIT:
So you are curious why it worked at all. The following should shed a light on it:
Sub test()
Dim i As Long
Debug.Print "Right", "Wrong", "Rows.Count & i"
For i = 1 To 32
Debug.Print Cells(Rows.Count, i).Address, _
Cells(Rows.Count & i).Address, Rows.Count & i
Next i
End Sub
In a nutshell, Cells can have 1 or 2 arguments. When 1 argument is used, it refers to the n-th cell of a range, and it 'counts' by row. The more common usage is with 2 arguments: rows, columns. For example:
Cells(5, 10) ' refers to cell `J5`.
Using one argument is inconvenient here:
Cells(16384 * (5-1) + 10)
i.e.
Cells(65546)
It may be convenient when processing a one-column or a one-row range.
Well , let me see if i understand you have a table in worksheet table have 32 columns and X rows (because you only put WS and i can know if is WS=worksheet or WS= Table-range)
for this i am going to say is selection (if you put worksheet only hace to change for it)
in your code put:
Last_Col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
but in this you always wil obtein 1st cell so i dont understand why exist?
WS.columns.count
return number of columns you selection have
.End(xlToLeft)
return last cell if star to move to left (like Ctrl - left key)
so
Last_Col ---first go to cells (1,ws.Columns.Count) then go to left (End(xlToLeft)) and the end return number of column where finish (.Column) in this case you always get cell (1,"first column of your table")
NOTE: because you wrote that you have allways value in your cells (I have 32 columns with data (various number of rows in columns)
And for Row you have same question
Then you Wrote you want "Delete" but in your code you put Erase value (.ClearContents) so what do you want? because both are no equal
BUT if you have a table and want to search in any cells that have "Download" and only want to "clear content" you just may to use ".find" instead; or if you want to do all at same time you can use .replace (need to check before if .find return "nothing" or no , because if return nothing you get error)
If you have a table with 32 columns and each row have one cell where you put "Donloaded" and want to "delete" all row your code only need select column where appear "downloaded" (example Column "status").
If you have a table where any cell can take value "downloaded" and want to "delete" that cell you need to take care to resize your table and "move to" (when you delete cells you need to say where you want to move yor data remain "letf, "rigth", "up", down).
However if you say that "Downloaded" always appear in last row you can use For to change for all columns and use .end(xlDown)
For i=1 to 32
if cells(1,i).end(xlDown).value="downloaded" then cells(1,i).end(xlDown).ClearContents
next
BUT you need put more information because if you cant garantize that all cells have values and exist cells with "nothing" you will need
I am trying delete a row if a cell has a specific value.
Sub DeleteRows()
'
' DeleteRows Macro
Dim Rng As Range
Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Set Rng = ActiveSheet.UsedRange
For i = Rng.Cells.Count To 1 Step -1
If Rng.Item(i).Value <> "M of E" Then
Rng.Item(i).EntireRow.Delete
End If
Next i
End Sub
I am selecting whole range in column B and trying to say if the value in the cell is not the phrase M of E, then the row should be deleted.
It deletes everything, even if the value of the cell is M of E.
If I change the <> operator in the code to an = operator, the code works, only deleting rows that have whatever text I specify.
I cannot figure out why the not equal operator isn't working.
I will identify what is wrong in your code and then show you what it should be.
First: don't use select, see This SO Question
Range("B1").Select
Second: using End(xlDown) searches down until the last used cell before the first blank cell, if there is a blank cell before the last filled cell, you will not select the whole used range.
Range(Selection, Selection.End(xlDown)).Select
Third: setting your range variable to UsedRange, selects every used cell, negating the range in Column B; e.g. If your used range was Range("A1:F20"), then Rng = Range("A1:F20")
Set Rng = ActiveSheet.UsedRange
Forth: you start your loop from the last cell in Rng to the first cell in Rng; e.g. using the above example, your loop would start at Range("F20") and the next cell in the loop would be Range("E20"), etc.
For i = Rng.Cells.Count To 1 Step -1
Fifth: Your If statement checks for the text in each cell of Rng. Thus, it will check Range("F20") first, and since your text is not in a cell until Column B. So, the first and subsequent cells will be True for <> and the row will be deleted. The loop will still check every cell left in the row and delete the row again-and-again, and then start the next row with the same outcome. etc.
If Rng.Item(i).Value <> "M of E" Then
Rng.Item(i).EntireRow.Delete
End If
Below is basic code to loop through each cell in column B, and delete the rows that don't have "M of E",
Sub DeleteRows()
' DeleteRows Macro
'you should always set the workbook and worksheet
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
'assign a last row variable using .End(xlUp).Row
Dim lRow As Long: lRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
'loop from the last row to the second row(skip header)
For i = lRow To 2 Step -1
'use Cells to set the row and column and check for "M of E".
If ws.Cells(i, "B").Value <> "M of E" Then
'If the cell in Column B doesn't contain "M of E", delete the row.
ws.Cells(i, "B").EntireRow.Delete
End If
Next i 'loop
End Sub
I am trying to write a macro that tidies up and interrogates raw data exported from some analytical instrumentation. I would like it to look through one column (sample names) down all rows and look for indicators of specific sample types e.g. duplicates. Finding these indicators I want to insert a row, and in the new inserted row do some simple calculations based on the two rows above. For now I will just be happy getting the row insertion to work.
I can get it to find the key word and insert 1 row, but it finds the first one and stops. There are multiple instances of these keywords in my data, and i want to insert a row below each
'original code - finds first keyword, inserts row and stops
Sub dup_finder()
Dim colHeader As Range
Set colHeader = Range("B1:B500")
Dim currCell As Range
Set currCell = Cells.Find("*_dup")
If Not currCell Is Nothing Then currCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
End Sub
'my attempt to include loop - inserts 500 rows below keyword! stops
after first instance
Sub dup_finder()
Dim colHeader As Range
Dim row As Long
Dim currCell As Range
Set colHeader = Range("B1:B500")
Set currCell = Cells.Find("_dup")
For row = 1 To 500
If Not currCell Is Nothing Then currCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Next row
End Sub
I suggest always fully qualifying your ranges with the workbook and sheet.
You should be able to adapt this to what you want. You simply enter the range you want to check in, and the value you are checking for.
It works backwards, up through the range, inserting a row below each one it finds.
Sub InsertRows()
''Declare your variables
Dim RngToCheck As Range, ValToFind As String
''Set the range in which to look for your desired string.
Set RngToCheck = ThisWorkbook.Sheets("Sheet1").Range("B1:B500")
''Set what string to look for.
ValToFind = "_dup"
''Declare a variable to use as a counter
Dim i As Long
''Count backwards through each of the rows in the range.
''(If you went forwards through the range, the rows you
''are inserting would become part of that range and push
''the bottom rows (which you intended to check) out of the range).
For i = RngToCheck.Rows.Count To 1 Step -1
''Check if the last characters (the number of characters to
''check is defined by the length of the string we are looking
''for) of the current cell match the string we are looking for.
If Right(RngToCheck(i).Value, Len(ValToFind)) = ValToFind Then
''Insert the row (we need to offset by 1 row
''because rows are inserted ABOVE, and we
''want it BELOW the current cell).
RngToCheck(i).Offset(1, 0).EntireRow.Insert
''Now you can add your formulas to the new row...
''column A
RngToCheck(i).Offset(1, -1).Formula = "=1+1"
''column B
RngToCheck(i).Offset(1, 0).Formula = "=2+2"
''column C
RngToCheck(i).Offset(1, 1).Formula = "=A" & RngToCheck(i).Offset(1, 1).Row & "+B" & RngToCheck(i).Offset(1, 1).Row
''column D
RngToCheck(i).Offset(1, 2).Formula = "Hello"
''And so on...
End If
Next i
End Sub
Assuming you do want to insert a row under every instance of a cell in column B containing "_dup" this should work.
The problem with your code was that it wasn't looping and so only ever found one instance.
It's advisable not to specify a fixed range as you are inserting rows and the range will expand; however, you could do this and set the search direction as "previous".
Sub dup_finder()
Dim colHeader As Range, s As String
Set colHeader = Range("B1:B500") ' not actually used
Dim currCell As Range
'are we searching just B or the whole sheet?
Set currCell = Columns(2).Find(What:="_dup", Lookat:=xlPart, MatchCase:=False, SearchFormat:=False) 'change parameters to suit
If Not currCell Is Nothing Then
s = currCell.Address 'store address of first found cell
Do
currCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Set currCell = Columns(2).FindNext(currCell) 'find next case
Loop Until currCell.Address = s 'keep looping until we are back to the original case
End If
End Sub
Please see below code I have found on the internet, which is currently working to a certain degree for me.
Could someone possibly commentate on what each line of this code means so I can understand what its doing?
Im trying to understand it with little programming knowledge and add additional code to look for additional values to paste into additional sheets.
I'm also trying to work out how to make them paste to certain rows one after the other and not maintain the row they were originally in on sheet 1.
Code:
Sub Test()
Dim rw As Long, Cell As Range
For Each Cell In Sheets(1).Range("H:H")
rw = Cell.Row
If Cell.Value = "Dept 1" Then
Cell.EntireRow.Copy
Sheets("Sheet2").Range("A" & rw).PasteSpecial xlPasteValues
End If
Next
End Sub
--
Many thanks
I've added comments as requested. To paste them onto the same row, look at removing the rw variable and replacing it with something that increments by one each time
Sub Test()
'declare variables
Dim rw As Long, Cell As Range
'loop through each cell the whole of column H in the first worksheet in the active workbook
For Each Cell In Sheets(1).Range("H:H")
'set rw variable equal to the row number of the Cell variable, which changes with each iteration of the For loop above
rw = Cell.Row
'check if the value of Cell variable equals Dept 1
If Cell.Value = "Dept 1" Then
'copy the entire row if above is true
Cell.EntireRow.Copy
'paste to the same row of Sheet 2
Sheets("Sheet2").Range("A" & rw).PasteSpecial xlPasteValues
End If
Next
End Sub
Here is your Code Commented hope you understand:
Sub Test()
' Variables Defined as follows:
Dim rw As Long, Cell As Range
' Loop Searching each Cell of (Range H1 to end of last H on sheet1
For Each Cell In Sheets(1).Range("H:H")
' now determine current row number:
rw = Cell.Row
' Test cell value if it contain >> Dept 1 as value:
If Cell.Value = "Dept 1" Then
' Select that row and copy it:
Cell.EntireRow.Copy
' now paste the values of that row into A column and rw row on sheet2:
Sheets("Sheet2").Range("A" & rw).PasteSpecial xlPasteValues
' You should add following to:
' Disable marching ants around copied range:
Application.CutCopyMode = False
End If
Next
End Sub
Thanks for helping me out. I couldn't find a solution to this on the web so here a am :P. I am wondering how to paste a range of values, in this case C6:R371, to another worksheet in the same size. My problem is that I only want to paste data from the source worksheet into cells that are blank on the target worksheet and not change the values that are already in the range C6:R371 on the target worksheet. Essentially, I have a range of cells that i need to c&p, but i want the macro to only paste values from the range onto the blank cells of the target range. Thank you so much
Range("C6:S371").Select
Selection.Copy
wbWest2.Activate
Dim rng As Range
Dim row As Range
Dim cell As Range
Set rng = Range("D9:S374")
For Each row In rng.Rows
For Each cell in row.Cells
If cell.value = 0 then selection.paste
Next cell
Next row
Isolate the two worksheets using With ... End With statements so thier cells are the only ones that are considered. The fastest comparison would be bulk loading the two ranges into variant arrays.
Sub fill_blanks_from_source()
Dim r As Long, c As Long, aSRCs As Variant, aDSTs As Variant
With Worksheets("Sheet1") '<~~ source
aSRCs = .Range("C6:R371").Value2
End With
With Worksheets("Sheet2") '<~~ destination
aDSTs = .Range("D9").Resize(UBound(aSRCs, 1), UBound(aSRCs, 2)).Value2
End With
For r = LBound(aDSTs, 1) To UBound(aDSTs, 1)
For c = LBound(aDSTs, 2) To UBound(aDSTs, 2)
If Not CBool(Len(aDSTs(r, c))) Then
aDSTs(r, c) = aSRCs(r, c)
End If
Next c
Next r
With Worksheets("Sheet2")
.Range("D9").Resize(UBound(aDSTs, 1), UBound(aDSTs, 2)) = aDSTs
End With
End Sub
Once the comparisons have been met and blank values from the destination filled with values from the source, the entire variant array is returned to the destination worksheet.
The ranges will always remain the same size. Once the source values are loaded to the first variant array, the LBound and UBound functions are use for all further dimensioning of the destination range expanding from the cell in the top-left corner.