I want to create a bidimensional array to plot checkboxes in rows and cols. Nevertheless, this line is not working:
CheckB_Well(rows_C1, cols_C1).Location = New Point(40 + 50 * cols_C1, 20 + 25 * (well_rows - 1 - rows_C1))
The checkboxes are not shown in the location defined.
Sub Check_Panel()
Me.GroupBox3.Controls.Clear()
Dim CheckB_Well(,)
Dim rows_C1 As Integer
Dim cols_C1 As Integer
If Opt6.Checked = True Then
well_number = 6
well_rows = 2
well_cols = 3
ElseIf Opt12.Checked = True Then
well_number = 12
well_rows = 3
well_cols = 4
ElseIf Opt24.Checked = True Then
well_number = 24
well_rows = 4
well_cols = 6
End If
ReDim CheckB_Well(well_rows - 1, well_cols - 1)
For rows_C1 = 0 To well_rows - 1
For cols_C1 = 0 To well_cols - 1
CheckB_Well(rows_C1, cols_C1) = New CheckBox
CheckB_Well(rows_C1, cols_C1).Name = "Well" + Str(rows_C1) + ";" + Str(cols_C1)
CheckB_Well(rows_C1, cols_C1).Text = Str(rows_C1) + ";" + Str(cols_C1)
CheckB_Well(rows_C1, cols_C1).Visible = True
If rows_C1 Mod 2 = 0 Then
CheckB_Well(rows_C1, cols_C1).Location = New Point(40 + 50 * cols_C1, 20 + 25 * (well_rows - 1 - rows_C1))
Else
CheckB_Well(rows_C1, cols_C1).Location = New Point(40 + 50 * (well_cols - 1 - cols_C1), 20 + 25 * (well_rows - 1 - rows_C1))
End If
Me.GroupBox3.Controls.Add(CheckB_Well(rows_C1, cols_C1))
Next cols_C1
Next rows_C1
End Sub
You just need to set AutoSize to True:
CheckB_Well(rows_C1, cols_C1) = New CheckBox
CheckB_Well(rows_C1, cols_C1).AutoSize = True
Because it was drawing from left to right on even rows, the extra space from the default size was covering up the CheckBoxes to the right.
Side Note: What is the point of creating the 2D array Dim CheckB_Well(,)? It's a local variable, so it's not necessary:
Sub Check_Panel()
Me.GroupBox3.Controls.Clear()
If Opt6.Checked = True Then
well_number = 6
well_rows = 2
well_cols = 3
ElseIf Opt12.Checked = True Then
well_number = 12
well_rows = 3
well_cols = 4
ElseIf Opt24.Checked = True Then
well_number = 24
well_rows = 4
well_cols = 6
End If
For rows_C1 As Integer = 0 To well_rows - 1
Dim Y As Integer = 20 + 25 * (well_rows - 1 - rows_C1)
For cols_C1 As Integer = 0 To well_cols - 1
Dim CB As New CheckBox
CB.AutoSize = True
CB.Name = "Well" + Str(rows_C1) + ";" + Str(cols_C1)
CB.Text = Str(rows_C1) + ";" + Str(cols_C1)
If rows_C1 Mod 2 = 0 Then
CB.Location = New Point(40 + 50 * cols_C1, Y)
Else
CB.Location = New Point(40 + 50 * (well_cols - 1 - cols_C1), Y)
End If
Me.GroupBox3.Controls.Add(CB)
Next cols_C1
Next rows_C1
End Sub
Output:
Related
I have a little problem with my sub. This sub is calling to different functions, by using the sub's data. The first function finds one is finding the amount of unique values and the second function finds these values. However, the first function works fine because its output is a scalar value. However, the second function's output is an array. I have tried to search for a solution, but so far I have not succeeded. I have a theory that the issue has something to do with the ByRef A() As Integer. I have written the codes below, both for the sub and the second function.
Sub Test()
Dim A() As Integer
Dim n As Integer
Dim BB As Integer
n = 10
ReDim A(n, 2) '5 unikke
A(1, 1) = 1
A(2, 1) = 7
A(3, 1) = 2
A(4, 1) = 6
A(5, 1) = 3
A(6, 1) = 5
A(7, 1) = 1
A(8, 1) = 1
A(9, 1) = 1
A(10, 1) = 4
A(1, 2) = 1
A(2, 2) = 7
A(3, 2) = 2
A(4, 2) = 6
A(5, 2) = 3
A(6, 2) = 5
A(7, 2) = 1
A(8, 2) = 1
A(9, 2) = 1
A(10, 2) = 4
BB = Unikke(A) 'Unikke is the second function that provides the amount of unique values
Dim FF() As Integer
ReDim FF(BB, 1)
FF = HvilkeUnikke(A) 'the second function, which has the output of an array a.k.a the problem
End Sub
This is the function:
Public Function HvilkeUnikke(ByRef A() As Integer) As Integer
Dim L() As Integer
Dim B As Integer
Dim i As Integer
Dim i2 As Integer
Dim A2() As String
Dim BB As Integer
Dim C() As Integer
BB = Unikke(A)
ReDim C(UBound(A), 2)
ReDim A2(BB, 1)
ReDim L(BB, 1)
For i = 1 To UBound(A)
C(i, 1) = A(i, 1)
C(i, 2) = A(i, 2)
Next
For i = 1 To UBound(C)
B = 0
For i2 = 1 To UBound(C)
If C(i, 1) = C(i2, 2) Then
B = B + 1
If B > 1 Then
C(i2, 2) = 0
End If
End If
Next i2
Next i
B = 0
For i2 = 1 To UBound(C)
If C(i2, 2) > 0 Then
B = B + 1
L(B, 1) = C(i2, 2)
End If
Next i2
HvilkeUnikke = L
End Function
The results are as expected, but they should be in a variable inside my sub.
(The solution)
Sub test()
Dim FF() As Integer
Dim i As Integer
Dim A() As Integer
Dim n As Integer
Dim BB As Integer
n = 10
ReDim A(n, 2) '7 unikke
A(1, 1) = 1
A(2, 1) = 7
A(3, 1) = 2
A(4, 1) = 6
A(5, 1) = 3
A(6, 1) = 5
A(7, 1) = 1
A(8, 1) = 1
A(9, 1) = 1
A(10, 1) = 4
A(1, 2) = 1
A(2, 2) = 7
A(3, 2) = 2
A(4, 2) = 6
A(5, 2) = 3
A(6, 2) = 5
A(7, 2) = 1
A(8, 2) = 1
A(9, 2) = 1
A(10, 2) = 4
BB = Unikke(A)
ReDim FF(BB)
FF = HvilkeUnikke(A)
'Testing on the worksheet
For i = 1 To BB
Cells(i, 1) = FF(i)
Next
End Sub
And the function
Public Function HvilkeUnikke(ByRef A() As Integer) As Integer()
Dim L() As Integer
Dim B As Integer
Dim i As Integer
Dim i2 As Integer
Dim A2() As String
Dim BB As Integer
Dim C() As Integer
BB = Unikke(A)
ReDim C(UBound(A), 2)
ReDim A2(BB, 1)
ReDim L(BB)
For i = 1 To UBound(A)
C(i, 1) = A(i, 1)
C(i, 2) = A(i, 2)
Next
For i = 1 To UBound(C)
B = 0
For i2 = 1 To UBound(C)
If C(i, 1) = C(i2, 2) Then
B = B + 1
If B > 1 Then
C(i2, 2) = 0
End If
End If
Next i2
Next i
B = 0
For i2 = 1 To UBound(C)
If C(i2, 2) > 0 Then
B = B + 1
L(B) = C(i2, 2)
End If
Next i2
HvilkeUnikke = L
End Function
I have the same question as here: VBA counting multiple duplicates in array , but I haven't found an answer and with my reputation can't leave comment there.
I have an array with 150 numbers which could contain repetitive numbers from 1 to 50. Not always there are all 50 numbers in the array. Example of output of what I need:
- 10 times: 1, 2;
- 20 times: 3, 4 etc;
- 0 times: 5, 6, 7 etc.
I need to count how many combinations of duplicate numbers it has and what numbers are in those combinations including zero occurrence - which numbers are not in the array.
On mentioned above post there are solutions - but only when you know how many combinations of duplicates there are - and I don't know it - there could be 1 (all 150 numbers are equal) - ... - 20 ... up to 50 combinations if it contains all numbers from 1 to 50 three times each.
Appreciate any help and advice how to store output - finally it should be written to worksheet in the above mentioned format: [times] - [numbers] (here could be a string, example "5 - 6 - 7").
Here is what I've made for 5 combinations, but do 50 cases and then check 50 strings if they are empty or contain something to write to output is not very good option...
For i = 1 To totalNumbers 'my numbers from 1 to 50 or any other number
numberCount = 0
For j = 0 To UBound(friendsArray) 'my array of any size (in question said 150)
If i = friendsArray(j) Then
numberCount = numberCount + 1
End If
Next j
Select Case numberCount
Case 0
zeroString = zeroString & i & " - "
Case 1
oneString = oneString & i & " - "
Case 2
twoString = twoString & i & " - "
Case 3
threeString = threeString & i & " - "
Case 4
fourString = fourString & i & " - "
Case 5
fiveString = fiveString & i & " - "
Case Else
End Select
Next i
I have found possible option using Collection (but have got an headache with getting keys of collection...):
Dim col As New Collection
For i = 1 To totalNumbers
numberCount = 0
For j = 0 To UBound(friendsArray)
If i = friendsArray(j) Then
numberCount = numberCount + 1
End If
Next j
colValue = CStr(numberCount) & "> " & CStr(i) & " - " 'store current combination [key] and number as String
If IsMissing(col, CStr(numberCount)) Then
col.Add colValue, CStr(numberCount) 'if current combination of duplicates [key] is missing - add it to collection
Else 'if current combination [key] is already here - update the value [item]
oldValue = col(CStr(numberCount))
newValue = Replace(oldValue & colValue, CStr(numberCount) & "> ", "") 'delete combinations count
newValue = CStr(numberCount) & "> " & newValue
col.Remove CStr(numberCount) 'delete old value
col.Add newValue, CStr(numberCount) 'write new value with the same key
End If
Next i
For i = 1 To col.Count
Debug.Print col(i)
Next i
and IsMissing function (found here How to check the key is exists in collection or not)
Private Function IsMissing(col As Collection, field As String)
On Error GoTo IsMissingError
Dim val As Variant
val = col(field)
IsMissing = False
Exit Function
IsMissingError:
IsMissing = True
End Function
Output is like this [times]> [numbers]:
(array of 570 numbers)
114> 2 -
5> 6 -
17> 10 -
10> 3 - 8 - 19 - 21 - 30 -
6> 1 - 29 - 33 -
8> 5 - 9 - 13 - 23 - 25 - 28 - 37 - 40 -
4> 12 - 16 - 41 -
13> 43 -
12> 15 - 20 - 22 - 27 - 36 - 38 - 42 - 44 - 45 - 46 -
9> 4 - 7 - 11 - 14 - 34 - 47 - 48 -
7> 17 - 18 - 35 - 49 -
11> 24 - 26 - 31 - 32 - 39 - 50 -
Creating new array and count the number is more simple.
Sub test()
Dim friendsArray(0 To 50)
Dim vTable()
Dim iMax As Long
Dim a As Variant, b As Variant
Dim i As Long, s As Integer, n As Long
dim c As Integer
'Create Sample array to Test
n = UBound(friendsArray)
For i = 0 To n
friendsArray(i) = WorksheetFunction.RandBetween(0, 50)
Next i
'Your code
iMax = WorksheetFunction.Max(friendsArray)
ReDim vTable(0 To iMax) 'create new Array to count
For i = 0 To n
c = friendsArray(i)
vTable(c) = vTable(c) + 1
Next i
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To iMax
If IsEmpty(vTable(i)) Then
s = 0
Else
s = vTable(i)
End If
If dic.Exists(s) Then
dic.Item(s) = dic.Item(s) & " - " & i
Else
dic.Add s, i
End If
Next i
a = dic.Keys
b = dic.Items
Range("a1").CurrentRegion.Clear
Range("B:B").NumberFormatLocal = "#"
Range("a1").Resize(UBound(a) + 1) = WorksheetFunction.Transpose(a)
Range("b1").Resize(UBound(b) + 1) = WorksheetFunction.Transpose(b)
Range("a1").CurrentRegion.Sort Range("a1"), xlAscending
End Sub
I am making a program for a game. It takes the level of the class (of which you can have 8 simultaneous different ones of different level). Each class has different values for one Dim I have known as Defense, it has 6 different possibly levels. Each of those 6 levels corresponds with a value based on the level of each class.
I'm almost certain I need an array or a list, I've seen some examples here but I haven't seen something that quite fits my case.
Do I need to have an array within an array? Is that even possible?
I apologize if I'm horrible at explaining what I'm trying to accomplish.
An example would be if the person chose Strong Hero and then chose Level 4. Following that they'd pick Fast Hero and chose Level 5. I'm trying to get it to look at what the value for 4 would be for Strong Hero and the value for Fast Hero, find those and then add them into Def at the end.
Thank you in advance for anyone who is willing to put up with my ignorance!
Dim Def As Integer = 0
'Declares a single-dimension array of 10 values
Dim DefLvl(9) As Integer
Dim DefType As String = ""
Dim DefLvl1 As Integer = 0
Dim DefLvl2 As Integer = 0
Dim DefLvl3 As Integer = 0
Dim DefLvl4 As Integer = 0
Dim DefLvl5 As Integer = 0
Dim DefLvl6 As Integer = 0
Dim DefLvl7 As Integer = 0
Dim DefLvl8 As Integer = 0
Dim DefLvl9 As Integer = 0
Dim DefLvl10 As Integer = 0
'This sets the cmblevel.text = to an integer to be multiplied later
'Level 1
If cmbLevel1.Text = "1" Then
Level1 = 1
ElseIf cmbLevel1.Text = "2" Then
Level1 = 2
ElseIf cmbLevel1.Text = "3" Then
Level1 = 3
ElseIf cmbLevel1.Text = "4" Then
Level1 = 4
ElseIf cmbLevel1.Text = "5" Then
Level1 = 5
ElseIf cmbLevel1.Text = "6" Then
Level1 = 6
ElseIf cmbLevel1.Text = "7" Then
Level1 = 7
ElseIf cmbLevel1.Text = "8" Then
Level1 = 8
ElseIf cmbLevel1.Text = "9" Then
Level1 = 9
ElseIf cmbLevel1.Text = "10" Then
Level1 = 10
End If
'
If cmbClass1.Text = "Strong Hero" Then
HD1 = "8"
DefType = "Avg+"
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 3
DefLvl6 = 3
DefLvl7 = 4
DefLvl8 = 4
DefLvl9 = 5
DefLvl10 = 5
End If
'This formula will calculate Defense for each class and level
If DefType = "Poor" Then
DefLvl1 = 0
DefLvl2 = 1
DefLvl3 = 1
DefLvl4 = 1
DefLvl5 = 2
DefLvl6 = 2
DefLvl7 = 2
DefLvl8 = 3
DefLvl9 = 3
DefLvl10 = 3
ElseIf DefType = "Avg" Then
DefLvl1 = 1
DefLvl2 = 1
DefLvl3 = 2
DefLvl4 = 2
DefLvl5 = 3
DefLvl6 = 3
DefLvl7 = 4
DefLvl8 = 4
DefLvl9 = 5
DefLvl10 = 5
ElseIf DefType = "Avg+" Then
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 3
DefLvl6 = 3
DefLvl7 = 4
DefLvl8 = 4
DefLvl9 = 5
DefLvl10 = 5
ElseIf DefType = "Good" Then
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 4
DefLvl6 = 4
DefLvl7 = 5
DefLvl8 = 6
DefLvl9 = 6
DefLvl10 = 7
ElseIf DefType = "Good+" Then
DefLvl1 = 1
DefLvl2 = 2
DefLvl3 = 2
DefLvl4 = 3
DefLvl5 = 4
DefLvl6 = 4
DefLvl7 = 5
DefLvl8 = 6
DefLvl9 = 7
DefLvl10 = 7
ElseIf DefType = "Great" Then
DefLvl1 = 3
DefLvl2 = 4
DefLvl3 = 4
DefLvl4 = 5
DefLvl5 = 5
DefLvl6 = 6
DefLvl7 = 6
DefLvl8 = 7
DefLvl9 = 7
DefLvl10 = 8
End If
'This adds up to all 8 classes' DefLvls
Def = DefLvl1 + DefLvl2 + DefLvl3 + DefLvl4 + DefLvl5 + DefLvl6 + DefLvl7 + DefLvl8 + dexM
I need to calculate this in excel vba ,using array loop only :
round 0 round 1
9 28
65 84
28 47
84 103
41 60
66 85
115 134
I need to sum values in round 0 in loop so the sum result (408) must be divided by 7 , if not I WANT to sum one value from the round 1 (in this case 84 instead of 65 ) to the rest of values in round 0 so the sum result can divided by 7 . There will be so many round up to 7 . I need VBA code to accomplish this..
Notes :
round 0 and round 1 all in one two-dimensional array
My Question is : is there a way to sum values from different columns in multi-dimensional array ??
there is an image attached .
I appreciate any help or idea .
Thanks in advance
Excel VBA Array Model:
http://im56.gulfup.com/8rDErI.png
Here an example file contains macro "Question1.xlsm"
http://www.gulfup.com/?TKAAYM
Notes : click the link under the big green down arrow to download the file.
UPDATE :
here another macro to the file "Question1.xlsm" :
Sub A1()
Dim arrTemp1() As Integer
Dim sum1 As Integer
arrblkTable1 = Sheets("Sheet1").Range("blkTable1").Value
ReDim Preserve arrTemp1(0 To 1, 1 To 7)
For a = 0 To 1
sum1 = 0
For c = 1 To 7
arrTemp1(a, c) = arrblkTable1(c, 1) + (a * 19)
text6 = text6 & arrTemp1(a, c) & vbCrLf
Worksheets("TEST3").Cells(a + 1, c).Value = arrTemp1(a, c)
sum1 = sum1 + arrTemp1(a, c)
Next c
If XLMod(sum1, 7) = 0 Then
MsgBox "Yes " & sum1
Else
MsgBox "No " & sum1
End If
Next a
MsgBox text6
End Sub
Function XLMod(a, b)
' This replicates the Excel MOD function
XLMod = a - b * Int(a / b)
End Function
UPDATE : here a new update to the previous macro :
Sub A1()
Dim arrTemp1(), arrTemp2(), arrSUMs() As Integer
Dim sum1 As Integer
arrblkTable1 = Sheets("Sheet1").Range("blkTable1").Value
arrblkTable2 = Sheets("Sheet1").Range("blkTable2").Value
'-------------------------------- arrTemp1 ------------------------------
ReDim Preserve arrTemp1(0 To 1, 1 To 7)
For a = 0 To 1
sum1 = 0
For c = 1 To 7
arrTemp1(a, c) = arrblkTable1(c, 1) + (a * 19)
text6 = text6 & arrTemp1(a, c) & vbCrLf
Worksheets("TEST3").Cells(a + 1, c).Value = arrTemp1(a, c)
sum1 = sum1 + arrTemp1(a, c)
Next c
If XLMod(sum1, 7) = 0 Then
MsgBox "Yes " & sum1
Else
MsgBox "No " & sum1
For c = 1 To 7
sum1 = sum1 - arrTemp1(a, c)
arrTemp1(a, c) = arrblkTable1(c, 1) + ((a + 1) * 19)
sum1 = sum1 + arrTemp1(a, c)
If XLMod(sum1, 7) = 0 Then
MsgBox "Yes " & sum1 & " " & arrTemp1(a, c)
End If
Next c
End If
Next a
For x = 0 To UBound(arrTemp1)
For y = 1 To UBound(arrTemp1)
text7 = text7 & arrTemp1(x, y) & vbCrLf
Next y
Next x
MsgBox text7
End Sub
Function XLMod(a, b)
' This replicates the Excel MOD function
XLMod = a - b * Int(a / b)
End Function
I need now to put each sum1 in one array , how I can do that ??
If I understood it correctly you want something similar to this:
Sub p()
v = Range("A2:A8")
v1 = Sheets("Sheet1").Range("B2:B8")
s = Application.WorksheetFunction.Sum(v)
b = False
Count = 0
For i = 1 To 7
temp = v
temp(i, 1) = v1(i, 1)
s = Application.WorksheetFunction.Sum(temp)
b = s Mod 7 = 0
If b = True Then
Count = Count + 1
End If
Next
MsgBox Count
End Sub
It may help tremendously if you can give more detail about what problem you're trying to solve, instead of focusing on how to solve it this way. There is a possibility that there's another way of doing it that hasn't occurred to you that will be much simpler.
This isn't an answer. Yet. But it will take more space than is allowed in a comment to ensure we've got this right.
For your sample data:
round 0 round 1
9 28
65 84
28 47
84 103
41 60
66 85
115 134
You want to:
Sum all the values in Round 0 (9 + 65 + 28 + 84 + 41 + 66 + 115) = 408
Take that sum (408) mod 7 and see if the result is 0
408 / 7 = 58.28, so (408 mod 7) <> 0
If the result isn't 0 (as in this case)
Start substituting numbers from round 1 for numbers in Round 0
Sum (28 + 65 + 28 + 84 + 41 + 66 + 115) = 427
427 / 7 = 61 (427 mod 7) = 0
This is now your valid result set.
Had the first number in Round 1 been 29
Sum (29 + 65 + 28 + 84 + 41 + 66 + 115) = 428
428 / 7 = 61.14 so (428 mod 7) <> 0
Substitute the next number from round 1 for the next number from round 0
Sum (9 + 84 + 28 + 84 + 41 + 66 + 115) = 427
This is now your valid result set.
Is that the logic you're after?
What happens if you get to the end of round 1 and you don't find a total that (mod 7 = 0)?
I have to generate an ID using a macro and I'm facing some problems when there are 8 numeric values required.
The ID has to include numeric values for the 1st-8th charactera and the 9th must be alphabetic. From the 10th character onwards it has to be spaces.
These are my codes and I'm certain that there are no issues with the formula
Function GenerateRB()
strLastCharSelections = "X,W,M,L,K,J,E,D,C,B,A"
intNumber = GenerateRandomNumber(1000000, 9999999)
ReDim a(8)
For i = 1 To 8
a(i) = Mid(intNumber, i, 1)
Next
intTotal = a(1) * 9 + a(2) * 8 + a(3) * 7 + a(4) * 6 + a(5) * 5 + a(6) * 4 + a(7) * 3 + a(8) * 2
intRemainder = intTotal Mod 11
arrstrSplitLastCharSelections = Split(strLastCharSelections, ",")
strLastChar = arrstrSplitLastCharSelections(intRemainder)
GenerateRB = intNumber & strLastChar
End Function
The code works when its
ReDim a(7)
For i = 1 To 7
a(i) = Mid(intNumber, i, 1)
Next
intTotal = a(1) * 9 + a(2) * 8 + a(3) * 7 + a(4) * 6 + a(5) * 5 + a(6) * 4 + a(7) * 3
Any help will be appreciated as I'm very new to this, Thank you!
I'm assuming that GenerateRandomnNumber will return a numeric in the specified range - in this case, a seven digit number between 1000000 and 9999999.
So when selecting the ith digit in the statement a(i) = Mid(intNumber, i, 1), there are no issues when i is 1 to 7 - however, when it's 8 - there is no eighth digit, so the code will fail.