so i have this code, and i need to pass the value of array1 to array2,
but the value of array2 should be array1 + (key Mod 255) where key is put by the user
Private Sub mod_Btn_enc_Click(sender As Object, e As EventArgs) Handles mod_Btn_enc.Click
Dim counter As Integer = 0
If mod_TB_key.Text = "" Then
MessageBox.Show("Pls Input Modulo Key Value", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
modKey = mod_TB_key.Text
End If
modModulo = modKey Mod 255 'formula
mod_TB_mod.Text = modModulo 'i used this to show that it is working
'modbyte = array 1
'modconverted = array2
For Each i As Integer In modByte
counter += 1
modConverted(counter - 1) = modByte(i - 1) + (modModulo) 'formula used
Next i
mod_Tb_enc.Text = String.Join(" ", modConverted) 'show the array in textbox
here is my interface
i've managed to do it this way.
For i = 0 To modByte.GetUpperBound(0)
counter += 1
ReDim Preserve modConverted(counter - 1)
modConverted(counter - 1) = modByte(i) + (modModulo)
Next
thanks for explaining #phoog
Related
I would like to loop through my table, store values into array LotN() (in the picture there were 2 individual sample data sets, to illustrate that I may encounter different number of unique lot numbers) (and the screen cap was an illustration only. Data were actually stored in an 2D array A1()).
candidate = "blah"
' loop through records, add to arrays (skip adding duplicated values with the function IsInArray = false)
For i = 2 To LR
If .Cells(i, 5).Value = candidate And IsInArray(.Cells(i, 2).Value, lotN) = False Then
q = q + 1
lotN(q) = .Cells(i, 2).Value
End If
Next i
Debug.Print "q = " & q ' try to know how many records were thrown into the arrays
ReDim Preserve lotN(1 To q)
Usually q will be equal to 1 to 3 for my data, but I have to prepare for q up to 6, for the procedures below. The next step I needed was to count the number of elements in another array A1() matching each of the elements in LotN().
' use counter to check the number of data pieces from another array A1() matching the elements within the array LotN()
For k = 1 To r
If A1(k, 2) = lotN(1) And lotN(1) <> "" Then
c = c + 1
End If
If A1(k, 2) = lotN(2) And lotN(2) <> "" Then
d = d + 1
End If
If A1(k, 2) = lotN(3) And lotN(3) <> "" Then ' with q = 2, the code stopped at this line with error "script out of range"
e = e + 1
End If
If A1(k, 2) = lotN(4) And lotN(4) <> "" Then
f = f + 1
End If
If A1(k, 2) = lotN(5) And lotN(5) <> "" Then
g = g + 1
End If
If A1(k, 2) = lotN(6) And lotN(6) <> "" Then
h = h + 1
End If
Next k
I want to create counters (c, d, e, f, g, h in the lines above) for each of the elements in the array. Since I am not sure how exactly q will be equal to, my attempt was to use lotN (position of element in this array) <> "" to allow increment of counters. That doesn't work, however. With q = 2, lines at or below the indicated will still cause an error "Script out of range".
How can I handle this error?
For this to work you will need the Microsoft Scripting Runtime library under tools-References.
This is the code commented:
Option Explicit
Const Candidate As String = "blah"
Sub Test()
'Here we will store the Candidates to enum
Dim Candidates As Dictionary: Set Candidates = LoadCandidates
'Another dictionary to hold the candidates on the array
Dim lotN As Dictionary: Set lotN = New Dictionary
For K = 1 To r
'If the value is in the Candidates Dictionary then
If Candidates.Exists(A1(K, 2)) Then
'If the Candidate is in the lotN already, add 1
If lotN.Exists(A1(K, 2)) Then
lotN(A1(K, 2)) = lotN(A1(K, 2)) + 1
'If not, add the candidate to the lotN and equal it to 1
Else
lotN.Add A1(K, 2), 1
End If
'output the number of times the candidate has appeared
A1(K, 7) = lotN(A1(K, 2))
End If
Next K
End Sub
Private Function LoadCandidates() As Dictionary
Set LoadCandidates = New Dictionary
For i = 2 To LR
If Cells(i, 5) = Candidate And Not LoadCandidates.Exists(Cells(i, 2).Value) Then
LoadCandidates.Add Cells(i, 2).Value, 1
End If
Next i
End
P.S.: Amend the code to fit your needs because you didn't post the whole code you need to reference the worksheet and workbook for the cells and give the A1 array...
Since the size of your array is variable, I advise you to instead of looping through a set range, to loop through the array itself.
counter = 0
For Each itm in lotN
counter = counter + 1
If A1(counter, 2) = itm Then
If counter = 1 Then
c = c + 1
ElseIf counter = 2 Then
d = d + 1
ElseIf counter = 3 Then
e = e + 1
ElseIf counter = 4 Then
f = f + 1
ElseIf counter = 5 Then
g = g + 1
ElseIf counter = 6 Then
h = h + 1
End If
End If
Next itm
I'm trying to find an index of the minimum value from sum(3) array. And it should be assigned to a variable min
min = index of minimum value
Should I sort the array first or is there any direct way of doing it?
Here is my code:
`Sub Min_index()
Dim Pt_array(3) As Single
Pt_array(0) = 0
Pt_array(1) = 12.3
Pt_array(2) = 16.06
Pt_array(3) = 20.11
Dim Ad_E_array(3) As Single
Dim Lo_E_array(3) As Single
Dim Bs_temp As Single
Dim i As Integer
i = 0
Do While i < 4
Bs_temp = BS
Ad_E_array(i) = Ad_E 'defined in previous Sub
Lo_E_array(i) = Lo_E 'defined in previous Sub
If Bs_temp + Pt_array(i) - Qth < BS_Maximum_limit Then
Bs_temp = Bs_temp + Pt_array(i) - Qth
Ad_E_array(i) = Ad_E_array(i) + 0
Lo_E_array(i) = Lo_E_array(i) + 0
Call function_decide(int_forecast_hour - 1, Bs_temp, Qth + 1, Lo_E_array(i), Ad_E_array(i))
Else
Lo_E_array(i) = Pt_array(i) - Qth - (BS_Maximum_limit - Bs_temp)
Bs_temp = BS_Maximum_limit
Call function_decide(int_forecast_hour - 1, Bs_temp, Qth + 1, Lo_E_array(i), Ad_E_array(i))
End If
i = i + 1
Loop
Dim sum(3) As Single
Dim min As Single
i = 0
Do While i < 4
sum(i) = Abs(Lo_E_array(i)) + Abs(Ad_E_array(i))
i = i + 1
Loop
End Sub`
You can receive the 1-based index position of the element containing the minimum value with the an Excel Application object's use of the worksheet's MIN function and MATCH function.
Sub wqewuiew()
Dim Pt_array(3) As Single, p As Long
Pt_array(0) = 1000
Pt_array(1) = 12.3
Pt_array(2) = 16.06
Pt_array(3) = 20.11
p = Application.Match(Application.Min(Pt_array), Pt_array, 0)
Debug.Print p '<~~ 'p' is 2 (I changed the value of the first array element)
End Sub
I am trying to have my code prompt the user to select a range of data of 3 width and variable length. There will only be 30 values those with some rows being blank. I want to have these 30 values populate into 30 text boxes in a userform of mine (this is so values don't have to be manually entered). I looked around and figured my route should be Application.Inputbox and then pass it into an array were the blank rows can be weeded out with for loops. I don't know how to pass the user selected table into a 2D array though.
Sub selectRange()
Dim r(1 To 14, 1 To 3) As Variant, ran As Range, calB(1 To 30) As Long, i As Integer, j As Integer, k As Integer, l As Integer
dozerCal.Hide
Set r = Application.InputBox("Select the Cal B table.", Type:=8)
For j = 1 To 14
For i = 1 To 3
If Abs(r(j, i)) > 0 Then
calB(l) = r(j, i)
l = l + 1
End If
Next
Next
lx = calB(1)
ly = calB(2)
lz = calB(3)
rx = calB(4)
ry = calB(5)
rz = calB(6)
ix = calB(7)
iy = calB(8)
iz = calB(9)
sx = calB(10)
sy = calB(11)
sz = calB(12)
p1x = calB(13)
p1y = calB(14)
p1z = calB(15)
p2x = calB(16)
p2y = calB(17)
p2z = calB(18)
lfx = calB(19)
lfy = calB(20)
lfz = calB(21)
lrx = calB(22)
lry = calB(23)
lrz = calB(24)
rfx = calB(25)
rfy = calB(26)
rfz = calB(27)
rrx = calB(28)
rry = calB(29)
rrz = calB(30)
ActiveWorkbook.Close
dozercall.Show
End Sub
Thanks in advance for everyone's help.
Edit: I missed that you were using the input box wrong, however I will leave this answer as it presents a way to collapse a variable range of user input from a multidimensional array into a single dimension array.
This should get you started. Basically it will read the user's input, dynamically create a one-dimensional array of the correct size (rows * columns), and read all the values in the range the user selects to this one dimensional array. It will then loop through the one dimensional array and print the values back out to the window.
I think this is what you're looking for, but if you need further clarification I can add some. I added comments so you can see what each section is doing.
Option Explicit
Private Sub TestArrays()
Dim calBTemp() As Variant, calB() As Variant
Dim i As Long, j As Long, x As Long
Dim rngInput As Range
Set rngInput = Application.InputBox("Select the Cal B table.", "Select Range", Type:=8)
'Read the user input, check for empty input
'If empty input, exit the subroutine
If Not rngInput Is Nothing Then
calBTemp = rngInput
Else
Exit Sub
End If
'Create the one-dimensional array dynamically based on user selection
ReDim calB((UBound(calBTemp, 1) - LBound(calBTemp, 1) + 1) * (UBound(calBTemp, 2) - LBound(calBTemp, 2) + 1))
'Loop through our multidimensional array
For i = LBound(calBTemp, 1) To UBound(calBTemp, 1)
For j = LBound(calBTemp, 2) To UBound(calBTemp, 2)
'Assign the value to our one dimensional array
calB(x) = calBTemp(i, j)
x = x + 1
Next j
Next i
'Loop through our one dimensional array
For i = LBound(calB) To UBound(calB)
Debug.Print calB(i)
Next i
End Sub
So I just wasn't using the Application.Inputbox right. If you return it as a range it will configure to the proper sized 2D array it seams and you can call/manipulate data from there. Here is a working sub.
Sub selectRange()
Dim ran As Range, calB(1 To 30) As Double, i As Integer, j As Integer, k As Integer, l As Integer
dozerCal.Hide
Set ran = Application.InputBox("Select the Cal B table.", Type:=8)
l = 1
For j = 1 To 14
For i = 1 To 3
If Abs(ran(j, i)) > 0 Then
calB(l) = ran(j, i)
l = l + 1
End If
Next
Next
lx = calB(1)
ly = calB(2)
lz = calB(3)
rx = calB(4)
ry = calB(5)
rz = calB(6)
ix = calB(7)
iy = calB(8)
iz = calB(9)
sx = calB(10)
sy = calB(11)
sz = calB(12)
p1x = calB(13)
p1y = calB(14)
p1z = calB(15)
p2x = calB(16)
p2y = calB(17)
p2z = calB(18)
lfx = calB(19)
lfy = calB(20)
lfz = calB(21)
lrx = calB(22)
lry = calB(23)
lrz = calB(24)
rfx = calB(25)
rfy = calB(26)
rfz = calB(27)
rrx = calB(28)
rry = calB(29)
rrz = calB(30)
ActiveWorkbook.Close
dozerCal.Show
End Sub
This code will do the trick (and forces the user to select 3 columns and 14 rows):
Sub selectRange()
Dim selectedRange As Range
Dim errorMessage As String
errorMessage = vbNullString
Dim ran As Range, calB(1 To 30) As Long, i As Integer, j As Integer, k As Integer, l As Integer
Do
'doesn't handle cancel event
Set selectedRange = Application.InputBox("Select the Cal B table.", _
Type:=8, Title:="Please select 14 rows and 3 columns" & errorMessage)
errorMessage = "; previous selection was invalid"
Loop While selectedRange.Columns.Count <> 3 Or selectedRange.Rows.Count <> 14
For j = 1 To 14
For i = 1 To 3
If Abs(selectedRange.Cells(j, i)) > 0 Then
calB(l) = selectedRange.Cells(j, i)
l = l + 1
End If
Next
Next
...rest of your code
I'm writing a code that checks if a word has multiple of the same letters in it, so I split each letter into an array and wrote this code. the "correctGuesses" variable is supposed to be the number of duplicate letters. The Array contains the strings ("H, E, L, L ,O").
Dim newCharArray() As Char = wordArray(rndNumber).ToCharArray
ReDim Preserve charToString_2(newCharArray.Length - 1)
Dim cBoolean As Boolean = False
For i As Integer = 0 To (newCharArray.Length - 1) Step 1
charToString_2(i) = newCharArray(i)
MsgBox(charToString_2(i))
Next
For j As Integer = 0 To (charToString_2.Length - 1) Step 1
For b As Integer = 0 To (charToString_2.Length - 1) Step 1
MsgBox("Is " & charToString_2(j) & " = " & charToString_2(b) & "?")
If j = b Then
MsgBox(j & " is equal to " & b & ", continuing.")
Exit For
End If
If CStr(charToString_2(b)) = CStr(charToString_2(b)) Then
MsgBox("Yes, +1")
correctGuesses += 1
charToString_2(b) = "Replaced"
cBoolean = True
End If
MsgBox("No, Continuing.")
Next
Next
The first if statement works, so whenever j = b, it exits and proceeds. But then the next loop, it checks if "E" is equal to "H", and it returns true! I have no idea why!
Your algorithm is almost there. You can tweak it a little.
Dim stringtoCheck As String = wordArray(rndNumber)
For j As Integer = 0 To (stringtoCheck.Length - 2)
For b As Integer = j+1 To (stringtoCheck.Length - 1)
If stringtoCheck.chars(b) = stringtoCheck.chars(j) Then
correctGuesses += 1
cBoolean = True
End If
Next
Next
This provides counts for the different characters in a string. Casing is shown.
Dim wordToCheck As String = "heLlo racecar" 'note L and l
Dim lettercounts As New Dictionary(Of Char, Integer)
For Each c As Char In wordToCheck ' .ToUpperInvariant '.ToLowerInvariant
If Not lettercounts.ContainsKey(c) Then
Dim ct As Integer = wordToCheck.Count(Function(ch) ch = c)
lettercounts.Add(c, ct)
End If
Next
'show the counts
For Each ltrct As KeyValuePair(Of Char, Integer) In lettercounts
Debug.WriteLine(String.Format("{0} {1}", ltrct.Key, ltrct.Value))
Next
I am creating a search function that allows users to search up to 3 different properties at the same time in a database (prop1,2 and 3) and I have created this sub in VBA by putting the results for a searched prop into an array. However, now that I have up to 3 arrays I need to consolidate the arrays so that only the data that is duplicated in the arrays are displayed in the results. Is there any advice on how to 1) only look at the arrays for the properties that the user is searching for and 2) take only the data that is repeated into a final array so I can display it in a results range? Any help is greatly appreciated! Thanks!
Assuming that your entries are directly from a database and therefore are unique for one property, I can think of following steps for a simple solution:
Merge Arrays together (prop1, prop2, prop3 > temp)
Count occurrences for each element (in this example code tempCount)
Based on the knowledge about the occurrences, create the final array (here called result)
Dim prop1() As Variant
Dim prop2() As Variant
Dim prop3() As Variant
Dim temp() As Variant
Dim tempCount() As Integer
Dim result() As Variant
ReDim temp(UBound(prop1) + UBound(prop2) + UBound(prop3) + 1)
'merge arrays
Dim i As Integer
On Error Resume Next
For i = 0 To UBound(temp)
temp(i * 3) = prop1(i)
temp(i * 3 + 1) = prop2(i)
temp(i * 3 + 2) = prop3(i)
Next i
'count occurences
ReDim tempCount(UBound(temp) + 1)
Dim j As Integer
For i = 0 To UBound(temp)
tempCount(i) = 1
For j = 0 To i - 1
'comparison of elements
If temp(i) = temp(j) Then
tempCount(i) = tempCount(i) + 1
End If
Next j
Next i
ReDim result(UBound(temp) + 1)
'if an element occurs 3 times, add it to result
Dim count As Integer
count = 0
For i = 0 To UBound(tempCount)
If tempCount(i) = 3 Then
result(count) = temp(i)
count = count + 1
End If
Next i
To check for some samples I added this to the code. It simply prints out the arrays temp, result and tempCount to the columns A, B and C.
'some sample arrays
prop1 = Array("a", "b", "c", "d", "e")
prop2 = Array("b", "c", "f")
prop3 = Array("b", "c", "d", "g")
'some sample Output
'temp
Cells(1, 1).Value = "temp:"
For i = 0 To UBound(temp)
Cells(i + 2, 1).Value = temp(i)
Next i
'result
Cells(1, 2).Value = "result:"
For i = 0 To UBound(result)
Cells(i + 2, 2).Value = result(i)
Next i
'count:
Cells(1, 3).Value = "count:"
For i = 0 To UBound(tempCount)
Cells(i + 2, 3).Value = tempCount(i)
Next i
Notes: tempCount just holds the cumulative number of occurrences at the point the element is watched at.