I am attempting to write functiona that will give you the closest city from a list to a given coordinate or the state depending on a boolean value. here is what I have
Function GetCity(x As String, Optional b as Boolean) As String
Dim i As Long, count As Long, row As Long
Dim min As Double
Count = Range("Table_IVO").Rows.Count
min = 9999999
For i = 1 To Count
If dist(x, Range("Table_IVO")(i,1).Value) < min Then
min = dist(x, Range("Table_IVO")(i,1).Value)
row = i
End If
Next i
If b = True Then
GetCity = Range("Table_IVO")(row, 3).Value
Else
GetCity = Range("Table_IVO")(row, 2).Value
End If
End Function
The table is set as so
A B C
Coords City State
It gets in the loop but never loops? It dies before even executing the if
If b = True Then
GetCity = Range("Table_IVO")(row, 3).Value
Else
GetCity = Range("Table_IVO")(row, 2).Value
End
Though I might get more clarity by looking at complete code, but if this is exactly your code which u are executing, then probably you missed writing If at the end of End in the last line of your code sample, as in
If b = True Then
GetCity = Range("Table_IVO")(row, 3).Value
Else
GetCity = Range("Table_IVO")(row, 2).Value
End If
Depending on the environment you are executing your code, it may not show a compilation error.
Related
I am trying to apply if condition on data bound combobox but my code is not working. my combobox are getting data ComboBox5.DataSource = table2,ComboBox6.DataSource = table2,ComboBox6.DisplayMember = "name" from sql, My combobox has multiple names like "bob","sam","john" etc. I want to hide another combobox when i select "bob" else that comboboxes should visible. how should i do it?
Dim rv As Object = ComboBox3.Items.Cast(Of Object)().Where(Function(r) ComboBox3.GetItemText(r) = "bob").FirstOrDefault()
If ComboBox3.SelectedText = rv Then
ComboBox5.Visible = False
ComboBox6.Visible = False
ElseIf ComboBox3.SelectedText <> rv Then
ComboBox5.Visible = True
ComboBox6.Visible = True
End If
Here is some code that checks if a TextBox.Text value is in a Combobox.
Dim fn As String
For Each fn In cbType.Items
If fn = tbType.Text Then
Do the = Code from your project
Return
End If
Next
Dim fn2 As String
For Each fn2 In cbType.Items
If fn2 <> tbType.Text Then
Do the <> Code from your project
Return
End If
Next
Main point of this function is to return the most common movie genre.
Function MoviesByGenre(genreRng As Range) As String
Dim genreList(1 To 4) As String
Dim current As Integer
current = 1
For i = 1 To genreRng.count
Dim found As Integer
found = 0
For j = 1 To current
If genreList(j) = genreRng.Cells(i) Then
found = 1
Exit For
End If
Next j
If found = 0 Then
genreList(current) = genreRng.Cells(i)
current = current + 1
End If
Next i
Dim genreCount(1 To 4) As Integer
For i = 1 To 4
Dim count As Integer
count = 0
For j = 1 To genreRng.count
If genreRng.Cells(j) = genreList(i) Then
count = count + 1
End If
Next j
genreCount(i) = count
Next i
MoviesByGenre = FindMax(genreCount, genreList)
End Function
Now my FindMax function looks like this:
Function FindMax(valueArray, nameArray) As String
Dim max As Double
max = valueArray(LBound(valueArray))
For i = LBound(valueArray) + 1 To UBound(valueArray)
If valueArray(i) > valueArray(max) Then
max = i
End If
Next i
FindMax = nameArray(max)
End Function
FindMax appears to work well in other areas, but depending on the range I use for MoviesByGenre, it may or may not work. (sometimes it'll give me #VALUE!, other times it'll give me the actual most common movie genre, and i'm not sure why.) I'm using Excel 2016 for MacOS.
Do you mean something like that
Sub Test()
Dim a As Variant
a = Range("A1:A7").Value
MsgBox FindMax(a)
End Sub
Function FindMax(valueArray) As String
Dim max As Double
Dim i As Long
max = valueArray(LBound(valueArray), 1)
For i = LBound(valueArray) + 1 To UBound(valueArray)
If valueArray(i, 1) > max Then
max = valueArray(i, 1)
End If
Next i
FindMax = max
End Function
Below is a function that is supposed to return a random value between 1 and 10 that is not already in column A. It works fine in terms of finding the random value and exiting the loop but in excel when called using =Ang() the function returns #Value! as below.
Function Ang()
i = 0
Do
i = Application.WorksheetFunction.RandBetween(1, 10)
Ang = i
MsgBox Ang
Loop While Application.WorksheetFunction.IfNa(Application.WorksheetFunction.Match(i, Worksheets("Sheet2").Range("A:A"), 0), 0)
End Function
The issue is WorksheetFunction.Match will stop the code with an error if it is not found.
Use Application.Match instead:
Function Ang() as Long
Dim i as Long
i = 0
Do
i = Application.WorksheetFunction.RandBetween(1, 10)
Ang = i
MsgBox Ang
Loop While Not IsError(Application.Match(i, Worksheets("Sheet2").Range("A:A"), 0))
End Function
Or
Function Ang()
i = 0
Do
i = Application.WorksheetFunction.RandBetween(1, 10)
Ang = i
MsgBox Ang
Loop While Application.WorksheetFunction.CountIf(Worksheets("Sheet2").Range("A:A"), i)
End Function
Rather than hard-wiring in the range of numbers to avoid, why not make it an argument to the function?
Function NewRandom(R As Range, a As Long, b As Long) As Variant
'returns a random number in a,b which isn't in range R
Dim i As Long, k As Long, rand As Long
Dim c As Range
Dim avoid As Variant
Dim count As Long
ReDim avoid(a To b) As Boolean
For Each c In R.Cells
k = c.Value
If a <= k And k <= b Then
avoid(k) = True
count = count + 1
End If
Next c
If count = b - a + 1 Then 'error condition!
NewRandom = CVErr(xlErrValue)
Else
Do
rand = Application.WorksheetFunction.RandBetween(a, b)
Loop While avoid(rand)
NewRandom = rand
End If
End Function
Used like:
The function guards against an infinite loop. If in B1 I used =NewRandom(A1:A7,1,5) then the error #VALUE! would be returned. The code assumes that the range from a to b is not so large as to be a significant memory drain. If it is, then the array avoid can be replaced by a dictionary.
I have written a VBA function to calculate the weight of a determine the weight of a certain item from its model number by comparing it to the model number of items with known weights. For some reason it is only returning #NAME?
Here is the code:
Function getWeight(model As String) As Double
Dim weight As Double
weight = -1#
Dim compModel As String
compModel = ""
Dim prevNumMatches As Integer
prevNumMatches = 0
Dim numMatches As Integer
numMatches = 0
Dim i As Integer
Dim p As Integer
Dim samePump As Boolean
Dim sameMotor As Boolean
Dim special As Boolean
For i = 2 To 1000
compModel = CStr(Sheets("Weights").Cells(i, 1).Value)
For p = 1 To Len(compModel)
samePump = False
sameMotor = False
special = False
numMatches = 0
If p = 1 Then
If Mid(model, p, 1) = Mid(compModel, p, 1) Then
samePump = True
numMatches = numMatches + 1
End If
ElseIf p = 5 Then
If Mid(model, p, 1) <> "-" Then
special = True
End If
If Mid(model, p, 1) = Mid(compModel, p, 1) Then
numMatches = numMatches + 1
End If
ElseIf p = 9 Then
If Mid(model, p, 1) = Mid(compModel, p, 1) Then
sameMotor = True
numMatches = numMatches + 1
End If
Else
If Mid(model, p, 1) = Mid(compModel, p, 1) Then
numMatches = numMatches + 1
End If
End If
If samePump And (sameMotor Or special) Then
If numMatches > prevNumMatches Then
weight = CDbl(Sheets("Weights").Cells(i, 2).Value)
prevNumMatches = numMatches
ElseIf numMatches = prevNumMatches Then
If CDbl(Sheets("Weights").Cells(i, 2).Value) > weight Then
weight = CDbl(Sheets("Weights").Cells(i, 2).Value)
End If
End If
End If
Next p
Next i
If weight = -1# Then
getWeight = 0#
Else
getWeight = weight
End If
End Function
Why is this not returning a number as I expect?
Each iteration of the
p = 1 to len(compmodel)
loop resets all your Booleans to false. This means the statement
If samePump And (sameMotor Or special) Then
is never true because it never evaluates all of those on the same pass of the loop. Put the boolean setters before the start of the loop instead of in it.
samePump = False
sameMotor = False
special = False
numMatches = 0
For p = 1 To Len(compModel)
Also if you did want to use the debugger just run this. That way you can step through the code line by line and see whats going on.
Sub main()
Dim THingy As Double
THingy = getWeight("R221-FT-AA1")
MsgBox (THingy)
End Sub
The function is (implicitly) Public, so the only way to get a #NAME? error is to implement it in the wrong type of module, such that Excel doesn't know what =getWeight is referring to.
You need to add a standard procedural module (.bas) to your project, cut the function, and paste it in there.
Bugs aside, you should be able to call your UDF from the worksheet.
ThisWorkbook, as well as all Worksheet modules, UserForm modules, and plain class modules, are blueprints for objects, which means in order to call their public members you need to qualify the member calls with an instance of that class... and a UDF (or macro for that matter) call can't do that.
I found the problem. Even though the file was saved as a macro enabled workbook (.xlsm) macros were not enabled. When I reopened it this morning, it gave me the option to enable macros. Once I did that and corrected the code as Jared suggested, it all worked as planned.
I am using vb.net. I have following weird problems:
If I comment DGVCusClient.Rows.Add(), the cell in ("column1",0) does not display data. But in debug, I can see that the first cell has data assigned.
If I do not comment DGVCusClient.Rows.Add(), the cell in ("column1",0) displays its data correctly. However, it adds the row on the top for the first time. Except for the first row, it adds rows to the bottom as usual.
Dim i As Integer = DGVCusClient.CurrentRow.Index
If Not ContainRecord(tempCusid, tempCltid) Then
Dim i As Integer = DGVCusClient.CurrentRow.Index
DGVCusClient.Item("Column1", i).Value = "a"
DGVCusClient.Item("Column2", i).Value = "b"
'DGVCusClient.Rows.Add()
End If
Private Function ContainRecord(ByVal strCusid As String, ByVal strCltid As String) As Boolean
For i As Integer = 0 To DGVCusClient.Rows.Count - 1
If Not DGVCusClient.Item("Column1", i).Value Is Nothing AndAlso Not DGVCusClient.Item("Column2", i).Value Is Nothing Then
If DGVCusClient.Item("Column1", i).Value.ToString = strCusid AndAlso DGVCusClient.Item("Column2", i).Value.ToString = strCltid Then
Return True
End If
End If
Next
Return False
End Function
The following code can always add rows to the bottom, which is what I want. So I just need to first add new row, and then set values to current cells.
If Not ContainRecord("a", "b") Then
Dim i As Integer = DGVCusClient.CurrentRow.Index
DGVCusClient.Rows.Add()
DGVCusClient.Item("Column1", i).Value = "a"
DGVCusClient.Item("Column2", i).Value = "b"
End If