How to use string names in loop like form controls? - excel

In form controls we can use { controls("Textbox"&1) } as for loops.
My question is I have already defined the String as D1,D2,D3. I want to use like D as common and suffix as variable
sub abcd ()
dim i, k as integer
dim D1 as string
dim D2 as string
k="abcd1"
for i = 1 to 2
if k<> "" then 'like controls("textbox" & i ) for loop
"D"&i = true
Else "D" & i+1
end sub
It shows a messagebox with the error:
expected : line number or label or statement or end of statement

This code has several (actually a lot) of issues:
Dim i, k As Integer declares k As Integer but i As Variant in VBA you need to specify a type for every variable.
You declare D1 as String but True is a Boolean.
If you declare Dim D1 As String you cannot access the variabele with "D" & i = True. This is no valid syntax. Therefore you would need to use an array:
Dim MyArray(1 To 2) As Boolean
So you can access it like
MyArray(i) = True 'where i can be 1 or 2
If you declare k As Integer that means k repersents a number (without decimals). So you cannot put text in there k = "abcd1", this will produce a type missmatch. Also comparing k against a string (text) "" like If k <> "" Then will missmatch since k is a number.
Also have a look at data type summary to study which data type to use for which kind of data.
Your For i = 1 To 2 loop is missing a Next i in the end of the loop.
Your If statement is missing a End If in the end.
So in general I can only recommend you to study some tutorials or books about the basic syntax of VBA, you are lacking a lot of basic things.
So the following example might help you:
Option Explicit
Public Sub Test()
Dim i As Long
Dim MyArray(1 To 3) As Boolean
For i = 1 To 3
MyArray(i) = True
Next i
End Sub

Related

Nesting ParamArrays when declaring Excel VBA functions like SUMIFS?

Consider the following example: Lets say you want to make a function "JoinIfs" that works just like SUMIFS except instead of adding the values in the SumRange, it concatenates the values in "JoinRange". Is there a way to nest the ParamArray as it seems to be done in SUMIFS?
SUMIFS(sum_range, criteria_range1, criteria1, [criteria_range2, criteria2], ...)
I imagine the declaration should look something like this:
Function JoinIfs(JoinRange As Variant, _
Delim As String, _
IncludeNull As Boolean, _
ParamArray CritArray(CriteriaRange As Variant, Criteria As Variant)) As String
But nothing I try seems to compile and there might not be a way to nest ParamArrays. But the existence of functions like SUMIFS and COUNTIFS seems to suggest there might be a way to nest the ParamArrays.
This question duplicates AlexR's question Excel UDF with ParamArray constraint like SUMIFS. But that was posted a few years ago with no response so either the question didn't get enough attention or it was misunderstood.
Edit for clarification: This question is specifically about nesting ParamArrays. I'm not trying to find alternative methods of achieving the outcome of the example above. Imagine nesting ParamArrays on a completely different fictional function like "AverageIfs"
As per the documentation for the Function statement and Sub statement, a Function or Sub can only contain 1 ParamArray, and it must be the last argument.
However, you can pass an Array as an Argument to a ParamArray. Furthermore, you can then check how many elements are in the ParamArray, and throw an error if it isn't an even number. For example, this demonstration takes a list of Arrays, and which element in that array to take, and outputs another array with the results:
Sub DemonstrateParamArray()
Dim TestArray As Variant
TestArray = HasParamArray(Array("First", "Second"), 0)
MsgBox TestArray(0)
Dim AnotherArray As Variant
AnotherArray = Array("Hello", "World")
TestArray = HasParamArray(AnotherArray, 0, AnotherArray, 1)
MsgBox Join(TestArray, " ")
End Sub
Function HasParamArray(ParamArray ArgList() As Variant) As Variant
Dim ArgumentCount As Long, WhichPair As Long, Output() As Variant, WhatElement As Long
ArgumentCount = 1 + UBound(ArgList) - LBound(ArgList)
'Only allow Even Numbers!
If ArgumentCount Mod 2 = 1 Then
Err.Raise 450 '"Wrong number of arguments or invalid property assignment"
Exit Function
End If
ReDim Output(0 To Int(ArgumentCount / 1) - 1)
For WhichPair = LBound(ArgList) To ArgumentCount + LBound(ArgList) - 1 Step 2
WhatElement = ArgumentCount(WhichPair + 1)
Output(Int(WhichPair / 2)) = ArgumentCount(WhichPair)(WhatElement)
Next WhichPair
HasParameterArray = Output
End Function
(A list of built-in error codes for Err.Raise can be found here)
It seems like nesting a ParamArray is not possible.
I was hoping to get a function that looks like Excel's built in functions.
SUMIFS, for example seems to group pairs of parameters in a very neat way.
Based on the inputs of some users I made the following Function which seems to work quite well.
Function SJoinIfs(JoinRange As Variant, Sep As String, IncludeNull As Boolean, ParamArray CritArray() As Variant) As Variant
'Concatenates text based on multple criteria similar to SUMIFS.
'Sizes of ranges CritArray (0, 2, 4 ...) must match size of range JoinRange. CritArray must have an even amount of elements
'Elements of CritArray (1, 3, 5 ...) must be single values
Set JoinList = CreateObject("System.Collections.Arraylist")
'Set FinalList = CreateObject("System.Collections.Arraylist")
For Each DataPoint In JoinRange
JoinList.Add (CStr(DataPoint))
Next
JoinArray = JoinList.ToArray
CriteriaCount = UBound(CritArray) + 1
If CriteriaCount Mod 2 = 0 Then
CriteriaSetCount = Int(CriteriaCount / 2)
Set CriteriaLists = CreateObject("System.Collections.Arraylist")
Set CriteriaList = CreateObject("System.Collections.Arraylist")
Set MatchList = CreateObject("System.Collections.Arraylist")
For a = 0 To CriteriaSetCount - 1
CriteriaList.Clear
For Each CriteriaTest In CritArray(2 * a)
CriteriaList.Add (CStr(CriteriaTest))
Next
If CriteriaList.count <> JoinList.count Then 'Ranges are different sizes
SJoinIfs = CVErr(xlErrRef)
Exit Function
End If
MatchList.Add (CStr(CritArray((2 * a) + 1)))
CriteriaLists.Add (CriteriaList.ToArray)
Next
JoinList.Clear
For a = 0 To UBound(JoinArray)
AllMatch = True
For b = 0 To MatchList.count - 1
AllMatch = (MatchList(b) = CriteriaLists(b)(a)) And AllMatch
Next
If AllMatch Then JoinList.Add (JoinArray(a))
Next
SJoinIfs = SJoin(Sep, IncludeNull, JoinList)
Else 'Criteria Array Size is not even
SJoinIfs = CVErr(xlErrRef)
Exit Function
End If
End Function
This function makes use of another function SJoin() which I adapted some time ago based on the answer provided by Lun in his answer to How to replicate Excel's TEXTJOIN function in VBA UDF that allows array inputs.
I have adapted this Function to include the use of Numericals, VBA Arrays and Arraylists as well.
On Error Resume Next
'Sep is the separator, set to "" if you don't want any separator. Separator must be string or single cell, not cell range
'TxtRng is the content you want to join. TxtRng can be string, single cell, cell range or array returned from an array function. Empty content will be ignored
Dim OutStr As String 'the output string
Dim i, j, k, l As Integer 'counters
Dim FinArr(), element As Variant 'the final array and a temporary element when transfering between the two arrays
'Go through each item of TxtRng(), depending on the item type, transform and put it into FinArray()
i = 0 'the counter for TxtRng
j = 0 'the counter for FinArr
k = 0: l = 0 'the counters for the case of array from Excel array formula
Do While i < UBound(TxtRng) + 1
If TypeName(TxtRng(i)) = "String" Then 'specified string like "t"
ReDim Preserve FinArr(0 To j)
FinArr(j) = "blah"
FinArr(j) = TxtRng(i)
j = j + 1
ElseIf TypeName(TxtRng(i)) = "Range" Then 'single cell or range of cell like A1, A1:A2
For Each element In TxtRng(i)
ReDim Preserve FinArr(0 To j)
FinArr(j) = element
j = j + 1
Next
ElseIf TypeName(TxtRng(i)) = "Variant()" Then 'array returned from an Excel array formula
For k = LBound(TxtRng(0), 1) To UBound(TxtRng(0), 1)
For l = LBound(TxtRng(0), 2) To UBound(TxtRng(0), 2)
ReDim Preserve FinArr(0 To j)
FinArr(j) = TxtRng(0)(k, l)
j = j + 1
Next
Next
Else
TJoin = CVErr(xlErrValue)
Exit Function
End If
i = i + 1
Loop
'Put each element of the new array into the join string
For i = LBound(FinArr) To UBound(FinArr)
If FinArr(i) <> "" Then 'Remove this line if you want to include empty strings
OutStr = OutStr & FinArr(i) & Sep
End If
Next
TJoin = Left(OutStr, Len(OutStr) - Len(Sep)) 'remove the ending separator
End Function
Thanks to all who contributed to this question.

VBA duplicate string boolean function #NAME Error

This is probably very basic for most here, I have no background and just need some help. I have to write an isDup function in VBA to compare two tweets based on their similar word counts to determine if the tweets are duplicate or not, based on a decimal threshold chosen (0-1). If they are duplicates, the function will return true. Every time i call the function it returns a #NAME in the cell instead of a true/false, and was wondering if anyone can give me some tips or let me know what i am doing wrong. Thank you!
Option Explicit
Function isDup(tweet1 As String, tweet2 As String, threshold As Double) As Boolean
Set threshold = 0 - 1
Dim tweet1Split() As String
tweet1Split = Split(tweet1, " ")
Dim tweet2Split() As String
tweet2Split = Split(tweet2, " ")
Dim i As Integer
Dim j As Integer
Dim sameCount As Integer
For i = LBound(tweet1Split) To UBound(tweet1Split) Step 1
For j = LBound(tweet2Split) To UBound(tweet2Split) Step 1
If StrComp(tweet1Split(i), tweet2Split(j), vbTextCompare) = 0 Then
sameCount = sameCount + 1
Exit For
End If
Next j
Next i
Dim score As Double
Dim arraySize As Double
arraySize = UBound(tweet1Split) - LBound(tweet1Split) + 1
score = sameCount / arraySize
If score > threshold Then
isDup = True
Else
isDup = False
End If
End Function
Try this. Place the following in a standard code module...
Public Function isDup(tweet1$, tweet2$, threshold#) As Boolean
Dim c&, i&, j&, t1, t2
t1 = Split(tweet1, " ")
t2 = Split(tweet1, " ")
For i = 0 To UBound(t1)
For j = 0 To UBound(t2)
If Not StrComp(t1(i), t2(j), vbTextCompare) Then c = c + 1
Next
Next
isDup = (c / (UBound(t2) + 1)) > threshold
End Function
And then use it from a worksheet:
=isDup(A1,A2,0.5)
...assuming the text of two tweets to compare is in A1 and A2.
If you're getting the #NAME error when trying to use a User-Defined Function in a spreadsheet, it's because Excel doesn't recognise the function. Make sure the code for the function is going in a Module in the workbook where you are trying to use the function, as per the image below.
The only change you need to make to the code for the function to run is to delete the line:
Set threshold = 0 - 1
You can then test to ensure it's giving the desired result.
The function isn't available if you just place it in a Sheet or ThisWorkbook object. You need to insert a Module and place the code there.
It also isn't available to other workbooks, unless you add references in those workbooks or save it to an add-in which is then correctly installed. You can look or ask for help on those processes separately if needed.

Variables will not convert to integers

Currently messing around with macros in excel. One that generates a range that fills 3 columns of cells with 1-9.
Another that plots these numbers kind of like battle ship with x,y and v for the value.
I've gotten the number generation part working and I'm stuck on the plotting bit.
Currently the issue it that I'm getting an error "13" which means that my variables don't match up.
But i'm using a CInt to convert the variant to a int.
Debugging it seems like the for loop is getting all the values properly but just not converting.
Here is the code I have so far and a screenshot of the whole thing.
Sub random()
Dim MyRange As Range
Dim c As Integer, r As Integer
Set MyRange = Workbooks("test random gen").Sheets("Sheet1").Range("G16:I30")
For c = 1 To MyRange.Columns.Count
For r = 1 To MyRange.Rows.Count
Randomize
MyRange.Cells(r, c) = Int((9 - 1 + 1) * Rnd + 1)
Next r
Next c
End Sub
Sub Button6_Click()
Dim Board As Range
Dim Table As Range
Dim c As Integer, r As Integer
Dim Xboard As Integer, Yboard As Integer, Vboard As Integer
Dim Xboardv As Variant, Yboardv As Variant, Vboardv As Variant
Set Table = Workbooks("test random gen").Sheets("Sheet1").Range("G16:G30")
Set Board = Workbooks("test random gen").Sheets("Sheet1").Range("M16:U24")
For r = 1 To Table.Rows.Count
Xboardv = Table.Cells.Value
Yboardv = Table.Cells.Offset(columnOffset:=1).Value
Vboardv = Table.Cells.Offset(columnOffset:=2).Value
Xboard = CInt(Xboardv)
Yboard = CInt(Yboardv)
Vboard = CInt(Vboardv)
Board.Cells(Xboard, Yboard).Value = (Vboard)
Next r
End Sub
Hm, oke I'll recap what I mentioned in my comments above:
"It is getting stuck on the Xboard = CInt(Xboardv) line with the error "13""
You are creating an array of values with Xboardv = Table.Cells.Value. The array is sized 1 To 15, 1 To 1 and you need to use these index numbers as row and column parameters when you refer to any element in the array. So basically: Xboard = CInt(Xboardv(<X>,<Y>)).
"That did it but now it only does it for the first value of the array due to it being called out as (1,1)"
That is because you are constantly refering to the same element. However, you have created a loop with r variable allready. So you can use that to call different elements: Xboard = CInt(Xboardv(r,1))
I've neglected the fact that your structure is somewhat strange and you are creating the same array in a loop. So move that outside your loop and possibly use a For R = Lbound(Xboard) to Ubound(Xboard) loop instead. And you can just address values without having to convert them too.
Btw, no need for Integer variables at all. Use Long instead.
What's the reason for doing a conversion to begin with?
In cell 'D4', I've put the value 325, and I've run following piece of code:
Dim b As Integer
b = Range("D4").Value
Value b is 325, no problem. No conversion needed.

how to not enter if statement inside a loop if it have been executed

I have a for loop, and inside it i have if statement.
In my Excel I have a list that contains each value one time. Once I found it i don't want the code to even check the conditional, i want it to skip this part of the if statement completely each time the loop is executed, is it possible?
Here is my code and list:
the first iteration of the loop will find that "c" is the value so it will do what inside it (xc = i)
I don't want the code to even check "ElseIf Cells(1, i) = "c" again, like the following image, is this possible?
code as text:
Sub test()
Dim i, xa, xb, xc As Integer
For i = 1 To 5
If Cells(i, 1) = "a" Then
xa = i
ElseIf Cells(i, 1) = "b" Then
xb = i
ElseIf Cells(i, 1) = "c" Then
xc = i
End If
Next i
End Sub
My initial interpretation of your need was "if the code hits 'c' again, just don't act".
To do so, you could modify the logic as follows:
ElseIf (xc = 0) And (Cells(i, 1) = "c") Then
This way, as soon as xc is set, the first boolean expression would be False, and the overall condition would not ever be met again. As mentioned by #TimWilliams, VBA would still evaluate the second boolean expression, unlike other languages that feature short-circuiting options. #Gene's answer describes a way around this. Typically, for better performance, you would evaluate the simple conditions first, before resorting to costly ones.
Additional notes
In VBA, you must give a type to each variable. In your Dim line, only xc is an Integer, while the other variables are Variants.
An unqualified Cells() call operates on the currently active worksheet, which might not be the expected one. Suggestion: qualify Cells() with the CodeName of your worksheet. The CodeName is what you see or specify under a worksheet's (Name) property as seen from the Visual Basic editor. For example, if (Name) is Sheet1, use Sheet1.Cells(). This will only work if the code resides in the same workbook as Sheet1. If the code is behind the worksheet itself, you can even use Me.Cells().
When dealing with cell values as your code does, VBA is (silently) being nice and understands that, among the numerous properties of the Range class, Value is what you are interested in. It is better practice, however, to explicitly state the target property, such as in Sheet1.Cells(i, j).Value.
EDIT
Knowing the values will be distinct and that there are about 60 of them, I suggest you simply use a Dictionary, as shown below, to get each value's row in one go, without a cascade of Ifs:
Option Explicit
Sub test()
Dim i As Integer
Dim dict As Object 'Scripting.Dictionary
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To 5
dict(Cells(i, 1).Value) = i
Next
Debug.Print dict("a") '4
Debug.Print dict("b") '2
Debug.Print dict("c") '1
'Etc.
End Sub
if i understood your question you can try this code:
Sub test()
Dim i, xa, xb, xc As Integer
Dim a, b, c As Boolean
a = False
b = False
c = False
For i = 1 To 5
If Cells(i, 1) = "a" And a <> True Then
xa = i
a = True
ElseIf Cells(i, 1) = "b" And b <> True Then
xb = i
b = True
ElseIf Cells(i, 1) = "c" And c <> True Then
xc = 1
c = True
End If
Next i
End Sub
Boolean variable is setted true for example only when the cells(i,1)="a" and after the next "a" value are skipped...
hope this helps
I just wanted to "mod" Ferdinando's code so it's a bit more "readable", I think. The main (the substantive) difference between this version and Ferdinando's or Excelosaurus' is that the cell is not even tested once the value is detected. Remember that the question was: I don't want the code to even check "ElseIf Cells(1, i) = "c" again... So, this version does exactly that.
Sub test()
Dim i As Integer, xa As Integer, xb As Integer, xc As Integer
Dim aFound As Boolean, bFound As Boolean, cFound As Boolean
Dim r As Range
For i = 1 To 5
Set r = Cells(i, 1)
If Not aFound Then
If r = "a" Then xa = i: aFound = True
ElseIf Not bFound Then
If r = "b" Then xb = i: bFound = True
ElseIf Not cFound Then
If r = "c" Then xc = i: cFound = True
End If
Next i
End Sub
I don't like the idea of 60 ElseIfs. Please examine the code below. In order to test it, create a worksheet called "TestSheet" and enter your A1:A5 to cells H2:H6.
Sub TestSpike()
' 06 Jan 2019
Dim Rng As Range
Dim Items As Variant
Dim Spike As String
Dim Tmp As String
Dim i As Integer
Dim R As Long
Items = Split("c|b|0|a|1", "|")
With Worksheets("TestSheet").Columns("H")
For R = 2 To 6
Tmp = CStr(.Cells(R).Value)
If InStr(1, Spike, Tmp, vbTextCompare) = 0 Then
Spike = Spike & "|" & Tmp
On Error Resume Next
i = Application.WorksheetFunction.Match(Tmp, Items, 0)
If Err Then
MsgBox Tmp & " wasn't found in Array"
Else
MsgBox "i = " & i & " = Item " & Tmp
End If
End If
Next R
End With
End Sub
The code has a "Spike". Each item is first checked against the Spike. If it is found there no further tests are carried out. Else, it is added to the Spike.
New items, after being added to the Spike, are checked against the Array "Items" which would hold your 60 elements, separated by Chr(124) thus, Split("c|b|0|a|1", "|"). I use the worksheet function MATCH to look for the item in the array. The result is an index number (or an error, if not found). You can use this index number in a Select Case statement to process each item distinct from others, basically the same way as you now process it when the If statement returns True.
One idea you may find useful with this kind of setup is to use the index from the Match function to return a value from another array. The other array might, for example, contain function names and you use Application.Run to call a different function for each item. This would run significantly faster than examining 60-odd Select Case statements.

Split and sort strings components using Excel

I have a column in Excel with the format:
A01G45B45D12
I need a way to format it like this, that is divide the string into groups of three characters, sort the groups alphabetically and then join them together with a + sign between:
A01+B45+D12+G45
I wonder it this is possible using the built in formulas in Excel or if I have to do this using VBA or something else, I already have the code for this in C# if there is an easy way to use that from Excel. I have not written plugins for Excel before.
Edit to add:
The above is just an example, the string can be of "any length" but its always divisible by three and the order is random so I cannot assume anything about the order beforehand.
Sub ArraySort()
Dim strStarter As String
Dim strFinish As String
Dim intHowMany As Integer
Dim intStartSlice As Integer
strStarter = ActiveCell.Offset(0, -1).Value 'Pulls value from cell to the left
intHowMany = Int(Len(strStarter) / 3)
ReDim arrSlices(1 To intHowMany) As String
intStartSlice = 1
For x = 1 To intHowMany
arrSlices(x) = Mid(strStarter, intStartSlice, 3)
intStartSlice = intStartSlice + 3
Next x
Call BubbleSort(arrSlices)
For x = 1 To intHowMany
strFinish = strFinish + arrSlices(x) & "+"
Next x
strFinish = Left(strFinish, Len(strFinish) - 1)
ActiveCell.Value = strFinish 'Puts result into activecell
End Sub
Sub BubbleSort(list() As String)
'Taken from power programming with VBA
'It’s a sorting procedure for 1-dimensional arrays named List
'The procedure takes each array element, if it is greater than the next element, the two elements swap positions.
'The evaluation is repeated for every pair of items (that is n-1 times)
Dim First As Integer, Last As Long
Dim i As Long, j As Long
Dim temp As String
First = LBound(list)
Last = UBound(list)
For i = First To Last - 1
For j = i + 1 To Last
If list(i) > list(j) Then
temp = list(j)
list(j) = list(i)
list(i) = temp
End If
Next j
Next i
End Sub

Resources