I'm looking to use this code but modified so that it finds any cells that contain the words Abuse Neglect (like a partial match) - and then subsequently deletes the row. Any help is appreciated!
Sub TakeOutAllOtherCourses()
Last = Cells(Rows.Count, "D").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "D").Value) = "Abuse Neglect" Then
'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW
Cells(i, "A").EntireRow.Delete
End If
Next i
Try Instr
Sub TakeOutAllOtherCourses()
last = Cells(Rows.Count, "D").End(xlUp).Row
For i = last To 1 Step -1
If InStr(Cells(i, "D").Value, "Abuse Neglect") > 0 Then
Cells(i, "A").EntireRow.Delete
End If
Next i
End Sub
Check how Like operator works in this link (Like Operator - Visual Basic)
Code:
Sub TakeOutAllOtherCourses()
Last = Cells(Rows.Count, "D").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "D").Value) Like "Abuse Neglect*" Then
'Cells(i, "A").EntireRow.ClearContents ' USE THIS TO CLEAR CONTENTS BUT NOT DELETE ROW
Cells(i, "A").EntireRow.Delete
End If
Next i
End Sub
Should your column D have no blanks, here’s a possibile (but untested) way with neither AutoFilter nor loops:
Sub TakeOutAllOtherCourses()
With Range("D1", Cells(Rows.Count, "D").End(xlUp))
.Replace What:="Abuse Neglect*", Replacement:="", LookAt:=xlPart
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
Related
I want to change the cell style based on the row number. I am still new on VBA.
Here is my code:
Sub format()
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
If Rows.Count = 2 * i + 1 Then
Selection.Style = "Good"
ElseIf Rows.Count = 2 * i Then
Selection.Style = "Bad"
End If
ActiveCell.Offset(1, 0).Select
Next i
End Sub
The loop moves to the next cell but does not highlight if a criteria is met. May you please help me.
I suggest the following:
Option Explicit
Public Sub FormatEvenOddRowNumbers()
Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
For i = 1 To FinalRow
If i Mod 2 = 0 Then 'even row number
Cells(i, 1).Style = "Good"
Else 'odd row number
Cells(i, 1).Style = "Bad"
End If
Next i
End Sub
To test if a row number is "even" you can use If i Mod 2 = 0 Then also you don't need to test for "odd" because if it is not "even" it must be "odd" so you can just use Else without any criteria.
Try to avoid using .Select it makes your code slow. See How to avoid using Select in Excel VBA. Instead access the cells directly like Cells(row, column).
First, I think you missused Rows.Count.
Rows.Count returns the total number of rows of your sheet. So now your criteria is only highlighting the two rows that are in the middle of the sheet.
If I assume correctly that you want to put "Good" the Rows that are even and "bad" the ones that are odds. then you should change your code to something like this:
Sub format()
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
If i/2 = int(i/2) Then
Selection.Style = "Good"
ElseIf (i+1)/2 = int((i+1)/2) Then
Selection.Style = "Bad"
End If
ActiveCell.Offset(1, 0).Select
Next i
End Sub
Looking for some assistance programming a report. I'm in the early stages. I've hit a wall when attempting to conditionally subtract using VBA. I would like to Subtract 1 from Column C if Column B is greater than 1. Any assistance would be greatly appreciated. The code I have so far is below
Sub UniqueContactReport()
Columns("Z:AQ").EntireColumn.Delete
Columns("X").EntireColumn.Delete
Columns("V").EntireColumn.Delete
Columns("U").EntireColumn.Delete
Columns("J:S").EntireColumn.Delete
Columns("A:H").EntireColumn.Delete
Dim N As Long, i As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
For i = N To 1 Step -1
If Cells(i, "B") > 1 And Cells(i, "D") = 0 Then
Cells(i, "B").EntireRow.Delete
End If
Next i
End Sub
To succinctly address your question:
Sub ModifyColumnC()
Dim N As Long, i As Long
N = Cells(Rows.Count, "B").End(xlUp).Row ' See comment below
For i = 1 to N 'no need to go backwards because you are not deleting
If Cells(i, "B").Value > 1 Then
Cells(i, "C").Value = Cells(i,"C").Value -1
End If
Next i
End Sub
I have added .Value simply because I try to avoid implicit code. But yes, .Value is the default behaviour. I have left the code that determines the end row because all the following rows are going to be blank (thus <1) and this saves processing time (potentially a lot of it).
An alternative piece of code to do exactly the same thing.
Sub ModifyColumnC()
Dim N As Long, i As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 to N
Cells(i, "C").Value = Cells(i,"C").Value - IIf(Cells(i, "B").Value > 1,1,0)
Next i
End Sub
A nuance is that in the IIf command, all paths are evaluated. But in this case, both the true and false statements are simple constants and unlikely to raise any exceptions.
From your question it seems this is what you want.
Sub UniqueContactReport()
Columns("Z:AQ").EntireColumn.Delete
Columns("X").EntireColumn.Delete
Columns("V").EntireColumn.Delete
Columns("U").EntireColumn.Delete
Columns("J:S").EntireColumn.Delete
Columns("A:H").EntireColumn.Delete
Dim N As Long, i As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
For i = N To 1 Step -1
If Cells(i, "B") > 1 And Cells(i, "D") = 0 Then
debug.print Cells(i, "C").value - 1
End If
Next i
End Sub
you could make no loop and use AutoFilter():
Sub UniqueContactReport()
With Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row) 'reference column B cells from row 1 down to last not empty one
.AutoFilter field:=1, Criteria1:=">1" ' filter referenced range on their value being >1
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then ' if any filtered cell other then the header (first one)
With .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Offset(, 1) ' reference filtered cells corresponding ones one colum to the right
.Value = .Value - 1 ' lower referenced cell value by one
End With
If .Cells(1, 1).Value > 1 Then .Cells(1, 2) = .cell(1, 2) - 1 ' check if first cell is to be treated, too (first cell of filtered range is assumed as the "header" so doesn't get caught in filter action)
End If
.Parent.AutoFilterMode = False ' remove autofilter
End With
End Sub
BTW you can collapse all those EntireColumn.Delete statements into one:
Range("Z1:AQ1,X1, V1, U1, J:S, A:H").EntireColumn.Delete
but in this case you have to properly adjust the columns reference in the list since columns get deleted in one shot i.e. what-you-list-is-what-gets-deleted while in your previous approach the order of the delete statements affects which original columns gets actually deleted
I have an Excel table, in which some of the cells of the C column contain the word "Rinse" (the other cells have various other contents).
Using VBA code, here's how I would select all rows containing the word "Rinse" in the C column - this code works fine.
For i = 3 To 300
If Cells(i, 3).Value = "Rinse" Then
Rows(i).Select
Selection.FormatConditions.Delete
End If
Next
However, I want to do exactly the opposite, namely to select all rows NOT containing the word "Rinse" in the C column. I've tried the following, but it doesn't work.
For i = 3 To 300
If Cells(i, 3).Value = Not "Rinse" Then
Rows(i).Select
Selection.FormatConditions.Delete
End If
Next
How do I get this done?
Use the Instr function, like this:
If Instr(Cells(i, 3).Value, "Rinse") = 0 Then
Change this line of your code ( <> not equals to)
If Cells(i, 3).Value <> "Rinse" Then
The Like operator can be useful here:
If Not Cells(i, 3).Value Like "*Rinse*" Then
If "Rinse" can be found anywhere in your cell value
You could filter out the Rinse values and then select the visible cells.
Could be quicker than looking at each individual cell.
Public Sub Test()
Dim lRow As Long
With ThisWorkbook.Worksheets("Sheet1")
lRow = .Cells(.Rows.Count, 3).End(xlUp).Row
With .Range(.Cells(1, 3), .Cells(lRow, 3))
.AutoFilter Field:=1, Criteria1:="<>*Rinse*"
'Can replace Select in next row with .FormatConditions.Delete
.SpecialCells(xlCellTypeVisible).Select
End With
.ShowAllData
End With
End Sub
The advantage of this code is in its speed. Acceleration is achieved by referencing the sheet only once for every row and only once for the result, and by formatting only the used range columns instead of the entire rows.
Private Sub SelectNonContiguousRange()
Dim RngAddress() As String
Dim i As Long
Dim R As Long
ReDim RngAddress(300) ' this number should be
With ActiveSheet
For R = 3 To 300 ' equal to this number
' use = (equal) or <> (unequal) as required:
If .Cells(R, "C").Value <> "Rinse" Then
' If .Cells(R, "C").Value = "Rinse" Then
RngAddress(i) = .Range(.Cells(R, "A"), _
.Cells(R, .UsedRange.Columns.Count)).Address
i = i + 1
End If
Next R
ReDim Preserve RngAddress(i - 1)
.Range(Join(RngAddress, ",")).FormatConditions.Delete
End With
End Sub
BTW, you can use a variation of this code to select multiple rows simultaneously (like you can do with Ctl+Click), for example all rows containing the word "Rinse".
#Renee - Change the if condition line as shown below.
For i = 3 To 300
If Cells(i, 3).Value <> "Rinse" Then
Rows(i).Select
Selection.FormatConditions.Delete
End If
Next
I have pretty limited knowledge of VBA so hopefully I can explain what I'm trying to do! I'm trying to copy a row if it has anything > 0 in column J.
I then want to insert this copied row into a new row bellow that copied cell.
I would like this to loop through the whole worksheet so that every row with a value in J is repeated, the data in the worksheet varies in size, there will always be a value in column B till the data ends...
Here's my failed attempt to far..
Sub Copy_Cells()
For Each Objcell In ActiveSheet.Columns(10).Cells
Do
If Objcell.Value > 0 Then
Objcell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
Exit Sub
Loop Until IsEmpty(ActiveSheet.Columns(2).Cells)
End If
Next Objcell
End Sub
I think this is what you are trying to do.
Sub Copy_Cells()
botRow = 100
For i = botRow To 1 Step -1
If Cells(i, 10).Value > 0 Then
Rows(i).EntireRow.Copy
Rows(i + 1).Insert Shift:=xlDown
End If
Next i
End Sub
You would need to set the bottom row or you can implement a count of the used rows etc.
Sub Copy_Cells()
Dim totalRow as Integer
totalRow = Activesheet.Cells(1,2).End(xlDown).Row 'Count total row from B column
For Each Objcell In Activesheet.Range("J1:J" & totalRow)
If Objcell.Value > 0 Then
Objcell.EntireRow.Select
Selection.Copy
Selection.Insert Shift:=xlDown
End If
Next Objcell
End Sub
I want to find the value "No Results" and remove the row and two rows above it.
Name 1(A1)
(A2 is empty) App(B2) Efforts (C2)
No Results(A3)
Name 3 (A4)
Valid (A5)
Name 2(A6)
(A7 is empty)
No Results(A8)
I am able to remove the record were the value is, but not the records above it. Tried Cells(i-2, "A").EntireRow.Delete but it removes all records above it. Could you please help.
Sub Macro1()
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "A").Value) = "No Results" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
End Sub
Something like this should do the trick:
Public Sub Macro1()
Dim i As Long
For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If Cells(i, "A").Value = "No Result" Then
Range((i-2) & ":" & i).Delete
End If
Next i
End Sub
This works only if the sheet you want to 'filter' is the currently active sheet, if this is intended to run from a module it would be best to specify the sheet explicitly e.g. Sheets("Sheet1").Cells(i, "A").
The only real change I've made to your own attempt is the use of Range rather than Cells within your If statement. With the Range function we can reference an Excel range using a string e.g. Range("A1"). In this case specifically we construct a string referencing the rows (i-2) to i, so for i = 9 we are executing Range("7:9").Delete.