Looped If/Then Functions in Excel VBA - vba

I'm just starting to learn Excel VBA and I'm running into problems with a particular exercise. Given a column of 20 randomly generated integers between 0 and 100 in a column, I want to write a VBA program that writes in the column next to it "pass" if the number is greater than or equal to 50 and "fail" if the number is less than 50.
My approach involved using a looping function from i = 1 to 20 with an If statement for each cell (i,1) which would write pass or fail in (i,2).
Sub CommandButton1_Click()
'Declare Variables
Dim score As Integer, result As String, i As Integer
'Setup Loop function, If/Then function
For i = 1 To 20
score = Sheet1.Cells(i, 1).Value
If score >= 60 Then result = "pass"
Sheet1.Cells(i, 2).Value = result
Next i
End If
End Sub
Could I get some insight into what I'm doing wrong?
Thanks in advance!

Try something like this...
Sub CommandButton1_Click()
'Declare Variables
Dim score As Integer, result As String, i As Integer
'Setup Loop function, If/Then function
For i = 1 To 20
score = Sheets("Sheet1").Cells(i, 1).Value
If score >= 60 Then
result = "pass"
Else
result = "fail"
End If
Sheets("Sheet1").Cells(i, 2).Value = result
Next i
End Sub
You need to properly specify the worksheet your working with like Sheets("Sheet1").Cells(...
Add an else clause to set result to fail when the value is less than 60. otherwise it never changes after the first 'pass'
Move the End if inside the for loop, immediately after the score check...

The correction with the least amount of changes is the following :
Sub CommandButton1_Click()
'Declare Variables
Dim score As Integer, result As String, i As Integer
'Setup Loop function, If/Then function
For i = 1 To 20
score = Sheet1.Cells(i, 1).Value
If score >= 60 Then
result = "pass"
Sheet1.Cells(i, 2).Value = result
End If
Next i
End If
End Sub
Keep in mind that, in VBA, variables are global to the function; not local to the loop. As it was mentionned, you could also have wrote something like :
result = ""
if score >= 60 then result = "pass"
sheet1....

Related

VBA - improve the calculation efficiency when comparing cells

I'm using the following function to find out whether values of two cells are in two columns.
I have to compare 250 sets of two-cells with 6500 sets of two-cells.
Excel spent 30 seconds to caculate the result.
Could I improve the calculation efficiency?
Public Function CompareWithTwoCells(twoCells As Range, twoCols As Range)
Dim result As String
result = "False"
For n = 1 To twoCols.Rows.Count
If twoCols(n, 1) = "" Then
Exit For
End If
If twoCells(1, 1) = twoCols(n, 1) And twoCells(1, 2) = twoCols(n, 2) Then
result = "True"
Exit For
End If
Next
CompareWithTwoCells = result
End Function
here's a first step of possible enhancements (explanations in comments):
Public Function CompareWithTwoCells(twoCells As Range, twoCols As Range)
Dim cell As Range
Dim firstVal As Variant, secondVal As Variant
firstVal = twoCells(1, 1) ' store first cell value in a variable
secondVal = twoCells(1, 2) ' store second cell value in a variable
CompareWithTwoCells = "False"
For Each cell In twoCols.Columns(1).SpecialCells(xlCellTypeConstants) ' loop through first column not empty values
If firstVal = cell.Value2 Then ' check one column fisrt
If secondVal = cell.Offset(, 1) Then ' check second column only if first columns check is true
CompareWithTwoCells = "True"
Exit For
End If
End If
Next
End Function
a further significant enhancement would use array instead of ranges
Is there a reason you can't just use MATCH=MATCH? (assuming twoCells is A1:B1 and twoCols is F1:G6500)
=IFERROR(MATCH(A1,$F$1:$F$6500,0)=MATCH(B1,$G$1:$G$6500,0),FALSE)
This is almost instant on my machine.
As per #Zac's suggestion, add:
Dim twoCellsArr, twoColsArr
twoCellsArr = twoCells.Value2
twoColsArr = twoCols.Value2
Then change your twoCells and twoCols to twoCellsArr and twoColsArr.
If your twoCols doesn't change and you're doing repeated comparisons i recommend using a Dictionary to store the twoCols.Value as keys and the row number as values, then perform the lookup and comparing whether they are in the same row.

Find the first empty cell after a text in a row

I'm working on a project and need at the moment to find the first empty cell just after text cells in a row in Excel. To clarify, let me explain to you what I'm lookng for with this screenshot
I want to write a code to return for me for like an example in the case of the 20th row the number of column of the cell E20 even if the first empty cell is A20 but like I said, i want the first empty cell juste after the last "not empty" one.
for the 21th row the result will be C21, the 22th row it will be F22 and there you go
Here's the code I wrote but for some reason it doesn't work, please help.
Function emptyCell(ws As Worksheet, ligne As Integer)
Dim m, p, n As Integer
Dim suite(700) As Integer
For k = 0 To 700
suite(k) = 0
Next
emptyCell = 0
i = 1
Do Until suite(i) = 0 And suite(i - 1) = 1
If ws.Cells(ligne, i) <> "" Then
suite(i) = 1
End If
i = i + 1
emptyCell = emptyCell + 1
Loop
End Function
Sub test()
Dim d As Integer
empty_cell = emptyCell(Sheets("tmp"), 2)
MsgBox (empty_cell)
End Sub
The logic of my code is to assign 0 for empty cells and 1 in the other caase, run a test to find the first 1-0 that's gonna appear in my array and get the column order from the order of this "1"
I know I'm not that clear cause I didnt want it to make it a long post and english is not my first language.
Thanks in advance
All if you want to get the first empty cell after the last non empty cell, why not try it like this?
Function emptyCell(ws As Worksheet, Row As Long) As Range
Set emptyCell = ws.Cells(Row, ws.Columns.Count).End(xlToLeft).Offset(, 1)
End Function
Sub Test()
Dim empty_cell As Range
Set empty_cell = emptyCell(Sheets("tmp"), 20)
MsgBox empty_cell.Address
End Sub

How to integrate a MAX and IF statement into a FOR loop in VBA?

Trying to include an if statement into the MAX function and create a FOR loop in VBA.
What I want the code to do is to return the MAX value from column B into a new column when the value in column A equals the value in column I. I also have more than 1,000 rows in the data set and so I need a loop.
Here is a screenshot of data set of the data set I'm working with:
When I execute the following code (max_no_loop) on my data set, I get the output that I am looking for. However, I want to loop over 1,000 rows and so I need I2 to be changing with each step of the integration.
Sub max_no_loop()
Range("K2").FormulaArray = "=MAX(IF(A:A=I2,B:B))"
End Sub
After thinking about it, I came up with the function below(max_loop) where I changed I2 to Cells(i, 9), however, when I run the function on my data, I get name errors (#NAME?) and don't get the desired outcome.
Sub max_loop():
Dim i As Integer
For i = 2 To 11
Cells(i, 11).FormulaArray = "=MAX(IF(A:A=Cells(i, 9),B:B))"
Next i
End Sub
Why am I unable to make the function work when I integrate it into a for loop?
You need to pull out the variable part completely like below:
Sub max_loop():
Dim i As Integer
For i = 2 To 11
Cells(i, 11).FormulaArray = "=MAX(IF(A:A=" & Cells(i, 9).Address & ",B:B))"
Next i
End Sub
You need to take your variable i outside the " of the formula.
Try the code below:
Sub max_loop():
Dim i As Integer
For i = 2 To 11
Cells(i, 11).FormulaArray = "=MAX(IF(A:A=Cells(" & i & ", 9),B:B))"
Next i
End Sub

VBA in Excel - If statement Counter wont work

I have been trying to get this VBA script to work to automate a task, but I cannot get it to work.
Basically, I have a big task list in excel with multiple columns and over 1000 Rows. It contains the task, who it is assigned to, and if it is open or closed.
In column H is who it assigned to and column N is whether the task is opened or closed.
I am trying to search by last name and if it is OPEN to add one to the counter. The end goal is to get a total count of how many open tasks a person has. Also, some of the cells in column N (task status) has extra text like comments, etc. I am sure that a InStr Function to search for the one word within the Cell would work better, but I cannot figure it out...
here is my code
Sub statuscount()
Dim tasksheet As Worksheet
Dim simons_count As Integer
Set tasksheet = ThisWorkbook.Sheets("tasks")
lr = tasksheet.Cells(Rows.Count, 1).End(xlUp).Row
For x = 5 to lr
If tasksheet.Cells(x, 8) = "Simons" And tasksheet.Cells(x, 14) = "OPEN" Then
simons_count = simons_count + 1
End If
Next x
tasksheet.Range("$O$5").Value = simons_count
End Sub
Thanks for the help!
Using If/And gets tricky in VBA, you're better off nesting two if statements:
For x = 5 to lr
If tasksheet.Cells(x, 8) = "Simons" Then
If InStr(tasksheet.Cells(x, 14).Value, "OPEN") > 0 Then
simons_count = simons_count + 1
End If
End If
Next x
This is a more general function. Insert a module and past the below code in it. Than you can use the function just like any other Excel built-in function
Function LastNamecounter(lastName As String, status As String) As Long
LastNamecounter = 0
Dim tasksheet As Worksheet
Set tasksheet = ThisWorkbook.Sheets("tasks")
lr = tasksheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 5 To lr
If InStr(tasksheet.Cells(i, 8).Value, lastName) <> 0 And InStr(tasksheet.Cells(i, 14).Value, status) <> 0 Then
LastNamecounter = LastNamecounter + 1
End If
Next i
End Function

Adding to an array with select case

Hope someone can help with a puzzling problem.
I have an excel worksheet that has a lot of lines that need to be moved to different sheets.
I have a select case statement that sets 3 variables to true or false depending on whether the numbers in the first column match a case statement. This works ok but I now want to add a name to an array if the value is true.
The select case statement is as follows :
While LContinue
If LRow = Lastrow Then
LContinue = False
Else
Select Case Range("A" & LRow).Value
Case 30 To 39
MainSheet = True
'Tabs(0) = "Main"
Case 40 To 49
SecondSheet = True
'Tabs(1) = "Second"
Case 111 To 112
ThirdSheet = True
'Tabs(2) = "Third"
End Select
LRow = LRow + 1
End If
Wend
This is used to see if I need to add the sheet or not. to add the sheets I use the following code :
For i = LBound(Tabs) To UBound(Tabs)
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Tabs(i)
Next i
So what I would like to know is how would I go about adding the sheetnames to the array but only if the value in the select case is true.
Any help would be much appreciated.
Thanks
Why not use worksheet function 'CountIfs'?
It counts on multiple criteria and you do not need any loops so your code will run quicker.
CountIfs(testedRange, ">=30", testedRange, "<=39")
... calculates number of values in 'testedRange' which are >=30 and <=39. If there is at least one then just add your sheet, that's it. No loops, no arrays, no additional variables needed. HTH.
Public Sub test()
Dim testedRange As Range
Dim Lastrow As Long
Lastrow = 10
Set testedRange = ActiveSheet.Range("A1:A" & Lastrow)
With Application.WorksheetFunction
If .CountIfs(testedRange, ">=30", testedRange, "<=39") > 0 Then
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Main"
End If
If .CountIfs(testedRange, ">=40", testedRange, "<=49") > 0 Then
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Second"
End If
If .CountIfs(testedRange, ">=111", testedRange, "<=112") > 0 Then
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Third"
End If
End With
End Sub
Excel VBA is not very flexible when it come to working with actual arrays. But you can work with a collection instead:
SET tabs = new Collection
And then you can add a new value to it whenever you need to (e.g. in the CASE structure):
.
..
...
Case 40 To 49
SecondSheet = True
Tabs.add "Second"
...
..
The values of the collection can be accessed almost in the same way as those of an array:
for j=1 to tabs.count
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = tabs(j)
next j
Edit:
Since the code is re-entrant, i.e. there can be several instances when Range("A" & LRow).Value will be evaluated, we must make sure, that an item is set only once. This can be done easiest with a dictionary (instead of a collection):
Set tabs = CreateObject("Scripting.Dictionary")
Now it is easy to establish, whether a particular page has already been defined before:
..
...
Case 40 To 49
SecondSheet = True
tabs("Second")=1
The page creation loop then looks like this
for each k in tabs.keys
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = k
next k
The loop iterates over the keys only. There is no need to check for duplicate entries as all unique keys will be defined and listed only once!
To do this with an array you would want to:
declare a dynamic array of strings
declare a counter for the number of elements added
set the array's size to the largest value that it could possibly be
assign elements to the array, incrementing the counter for each addition
resize the array using the counter value (or test for empty elements when accessing array)
In code that could translate into something like:
Dim Tabs() as String
Dim counter As Long
...
Redim Tabs(0 to Lastrow)
counter = 0
...
While ...
Select Case .Range("A" & lrow).Value
Case 30 To 39
Mainsheet = True
Tabs(count) = "Main"
...
Case Else
counter = counter - 1
End Select
counter = counter + 1
...
Wend
If Not counter = 0 Then
Redim Preserve Tab(0 to counter - 1)
...
'create worksheets using Tabs(), etc.
...
End If