VBA Code for Conditional Loop - vba

I am trying to create a conditional loop macro in Excel. Column B contains a last name, Column C contains a first name, and Column D contains a first and last name. I am trying to get the macro to detect when Column D = Column C + Column B.
If D = C + B, then clear contents of D.
So, the following works for a single row:
Sub ClearContentsD ()
If Range("D1").Value = Range("C1").Value + Space(1) + Range("B1") Then Range("D1").ClearContents
End Sub
It does not work without the added Space(1), and I cannot get it to loop through the whole worksheet:
Sub ClearContentsLoop()
Application.ScreenUpdating = False
Dim i As Long
For i = 1 To Rows.Count
Next i
Do While Cells(i, 4).Value = Cells(i, 3).Value + Space(1) + Cells(i, 2).Value
Cells(i, 4).ClearContents
Loop
Application.ScreenUpdating = True
End Sub
VBA doesn't like my Do While. Any help would be greatly appreciated.
CJ

Some issues:
You must concatenate strings with &. The plus (+) is for addition;
Your For loop is not doing anything: its body is empty;
Your Do While Loop will at most run once, because i is not incremented;
It is a mystery why you would want two loops (For and Do While);
A sheet has many rows of which you only use a fraction, so don't loop through all of them (For) and use UsedRange.
Possible correction:
Sub ClearContentsLoop()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(i, 4).Value = Cells(i, 3).Value & " " & Cells(i, 2).Value Then
Cells(i, 4).ClearContents
End If
Next i
Application.ScreenUpdating = True
End Sub

There is a way to ignore the space in the values you are evaluating. Try this:
Application.ScreenUpdating = False
Dim i As Long
For i = 1 To Rows.Count
If InStr(1, Cells(i, 4).Value, Cells(i, 2).Value, vbTextCompare) > 0 And InStr(1, Cells(i, 4).Value, Cells(i, 3).Value, vbTextCompare) > 0 Then Cells(i, 4).ClearContents
Next i
Application.ScreenUpdating = True
Explanation:
By using the InStr function, you are testing for the presence of one text string inside of another, and if at least one match is found, then the function returns a non-zero value (the position where the match was found). In the above example, you are testing for the presence of the first name and last name at the same time, and if both are found, then the code clears out the contents of the cell.
And, as was pointed out in the comments section, you need to do this inside the loop so that all cells down the length of the worksheet are evaluated and updated as specified.
Be sure to test this on a COPY of your original data so that you don't lose the original values in case you want to roll back your changes! ;)

Related

Conditional Subtraction in VBA

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

How to select cells NOT containing a certain word

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

Merge Range upon change in change in column M

I am trying to right code that will merge columns "D" through "L" when the number changes in column "M."
I have the following code, but all it does is merge every row from bottom up to row 2 regardless of value in column "M."
What am I missing???
Sub Merge_Upon_Change()
'Purpose: Merges cells between columns "D" and "L" when column "M" changes
Dim r As Long, i As Long
Application.DisplayAlerts = False 'Turn off windows warning popup
r = Cells(Rows.Count, "D").End(xlUp).row ' find last cell in Column D
For i = r To 2 Step -1
If Cells(i, 13).Value <> Cells(i + 13, 13).Value Then 'upon change in column M = 13
Range("D" & i & ":L" & i).Merge 'then merge column "D" through "L"
End If
Next i
Application.DisplayAlerts = True ''Turn on Windows warning popup
End Sub
Actually you have already made this question but to pretend this from being unanswered I am posting this answer for any future search about this question.
When you write your equation as M i <> M i+13 then it simply finds every equation True (because probably i+13 th row is not equal to your i th row) and hereby it merges everything from bottom to the 2nd row as your For loop is until 2
Sub Merge_Upon_Change()
'Purpose: Merges cells between columns "D" and "L" when column "M" changes
Dim r As Long, i As Long
Application.DisplayAlerts = False 'Turn off windows warning popup
r = Cells(Rows.Count, "D").End(xlUp).row ' find last cell in Column D
For i = r To 2 Step -1
If Cells(i, 13).Value <> Cells(i + 1, 13).Value Then 'upon change in column M = 13
Range("D" & i & ":L" & i).Merge 'then merge column "D" through "L"
End If
Next i
Application.DisplayAlerts = True ''Turn on Windows warning popup
End Sub

Excel VBA. If Some Cell has a 0, Enter "TBD" in another Cell

I am looking to auto populate a cell with one of three strings, PASS, FAIL and TBD
The code I have below works for the PASS and FAIL senerios, but not for TBD
In one column (column A) I have the name of a bunch of files. If the filename contains the string "ANT" I have a tripping value, to populate a FAIL, of any value less than 9.54
Else, set the tripping value to 25.
What I would actually like is the following:
If the value contains SPT--SPT (where the astrics are any values before or after SPT) I have the tripping value set to 25
Else, if I see a 0 in column H enter "TBD" in column L
The latest code used a formula and is as follows:
Sub PassFail()
'Specify which sheet (name) of the active workbook we want to work on
With Sheets("(5) Coax Cable Sweeps Table")
'Determine the range we want to put values into
With .Range("L1:L" & .Range("A" & .Rows.Count).End(xlUp).Row)
'Put the standard worksheet formula into all cells at once by specifying the formula for the 1st cell only
'Note that any quote marks in the actual formula need to be doubled up at this point
'This line does not consider any zeros for DTF measurments taken without a load
.Formula = "=IF(H1<IF(ISNUMBER(SEARCH(""ANT"",A1)),9.54,25),""Fail"",""Pass"")"
'The below formula DOES NOT WORK as intended.
'.Formula = "=IF(H1=0,""TBD"",""=IF(H1<IF(ISNUMBER(SEARCH(""""ANT"""",A1)),9.54,25),""""Fail"""",""""Pass"""")"")"
.Value = .Value
End With
End With
End Sub
I then tried to use If, elseIf logic and came up with the following:
Sub PassFail_v1()
Dim x As Long
Application.ScreenUpdating = False
With ActiveWorkbook.Sheets(8)
For x = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If InStr(.Cells(x, 1).Value, "ANT") > 0 Then
.Cells(x, 12).Value = IIf(.Cells(x, 8).Value < 9.54, "Fail", "Pass")
ElseIf InStr(.Cells(x, 1).Value, "*SPT*-*STP*") > 0 Then
.Cells(x, 12).Value = IIf(.Cells(x, 8).Value < 25, "Fail", "Pass")
' Else
' .Cells(x, 12).Value = IIf(.Cells(x, 8).Value = 0, "TBD", " ")
End If
Next x
End With
Application.ScreenUpdating = True
End Sub
Which still doesn't work..
Some cells in column L are left blank, others with a 0 in column H show TBD in column L (which is nice), and others show FAILS at a 0 when they shouldn't.
Any advice?
So if I understand your code and your desired result, you are looking at Column A and if any part of the string in A(n) contains "ANT", the value to determine Pass/Fail is 9.54. If any part of A(n) contains the string "SPT-STP", then the pass/fail value is 25 (btw, using wildcards in a search requires LIKE and evaluates to a boolean.) However, if Column H contains a 0, then L(n) should be "TBD" regardless of the value in A(n), correct? If that's the case, you need two IF statements, with the one evaluating column H after the one evaluating Column A:
With ActiveWorkbook.Sheets(8)
For x = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If InStr(.Cells(x, 1).Value, "ANT") > 0 Then
.Cells(x, 12).Value = IIf(.Cells(x, 8).Value < 9.54, "Fail", "Pass")
ElseIf .Cells(x, 1).Value Like "*SPT*-*STP*" Then
.Cells(x, 12).Value = IIf(.Cells(x, 8).Value < 25, "Fail", "Pass")
End If
If .Cells(x, 8).Value = 0 Then
' .Cells(x, 12).Value = "TBD"
End If
Next x
End With
Addendum: It should be noted that if A(n) does not contain either "ANT" or some form of "SPT-STP", L(n) will be left blank. So if you see cells in column L that are blank, look at column A and determine what you want to do in those cases.
You have enclosed the second part of the formula in quotes. As it's additional to the formula, the = sign and the extra quotes are not needed
.Formula = "=IF(H1=0,""TBD"",""=IF(H1<IF(ISNUMBER(SEARCH(""""ANT"""",A1)),9.54,25),""""Fail"""",""""Pass"""")"")"
should be
.Formula = "=IF(H1=0,""TBD"",IF(H1<IF(ISNUMBER(SEARCH(""ANT"",A1)),9.54,25),""Fail"",""Pass""))"

How to match strings in cells on Excel, with if/or operators, and delete the rows

Disclaimer: I've never used Visual Basic and I've never made a macro.
I am trying to create a macro in Microsoft Excel 2010 that will delete all rows where neither column G nor column I contain the string "Ohio", "Indiana", or "Kentucky". To clarify, the row should be deleted if the cell does not contain either of those three state names. I want the macro to start at row 6, as rows 1-5 contain vital information. The whole sheet contains over 14000 rows and only ~1.5% of those are actually helpful.
Also, I am looking to be able to reuse this macro, but for other terms (besides Ohio, Indiana, and Kentucky) in other columns (besides G and I).
It may also help me if you can, besides correcting this, explain what exactly I am saying in these lines. Perhaps in Java terms, or Python is okay too. Not necessary, but may help.
Sub DeleteIfNotKYINOH()
Dim i, LastRow
LastRow = Range("G" & Rows.Count).End(xlUp).Row
For i = LastRow To 6 Step -1
I get a type mismatch error on the next line.
If Cells(i, "G").Value = "Ohio" Or "Indiana" Or "Kentucky" Then
Cells(i, "G").Value = True
End If
If Cells(i, "I").Value = "Ohio" Or "Indiana" Or "Kentucky" Then
Cells(i, "I").Value = True
End If
If Cells(i, "G").Value Or Cells(i, "I").Value = False Then
Cells(i, "G").EntireRow.Delete
End If
Next
' DeleteIfNotKYINOH Macro
' Delete all rows that do not contain Ohio, Indiana, or Kentucky, as a state.
'
'
End Sub
There are a few things to consider, it looks like you are on the right track, though, you even got the backwards iteration over the collection (this stumps a lot of people!).
Make sure to declare your variables properly (i and LastRow should probably be Long integer, not unspecified Variant type).
If statements can include Or joins, but have to be like this:
If Cells(i, "G").Value = "Ohio" Or Cells(i, "G").Value = "Indiana" Or Cells(i, "G").Value = "Kentucky"
Since you want to be able to re-use the macro for other strings, of course you could go in and edit each instance of "Ohio" or "Indiana", etc., but that can be tedious and error-prone.
You could do something like this instead to re-use it for a list of any number of states, just change the assignment to the states variable.
Const states as String = "Ohio,Indiana,Kentucky"
Sub TestDeleteIfNot()
Dim i as Long, LastRow as Long
Dim cl as Range
LastRow = Range("G" & Rows.Count).End(xlUp).Row
For i = LastRow To 6 Step -1
With Cells(i, "G")
If Not(InList(.Value, states)) And Not(InList(.Offset(0,2).Value, states))
.EntireRow.Delete
End If
End With
Next
End Sub
This routine calls on a function InList which accepts as its arguments two strings. The first string should be the value being compared, and the second is a comma-delimited "list" of allowable values.
Function InList(strVal as String, list as String) As Boolean
Dim a as Variant
For each a in Split(list, ",")
If strVal = a Then
InList = True
Exit For
End If
Next
End Function
The function converts the list to an array and iterates that against the compare value. It should return False if the value is not found. So then the logic in the calling sub runs this on cells in COlumn G and also Column I, only deleting the row if BOTH tests return False.