Upon trying to run my code I get the error "compile error: variable not defined" and it highlights my Sub line. Here is the code for reference.
Sub RI_Processing()
Dim i As Single
Dim Output() As Single 'Define this dynamic array for the solver output
Process the DMSO data
For i = 1 To 45 Step 1
Workbooks("Calibration Range 1 Normalized Profiles.xlsx").Activate
RawData.Range("C10:C649") = Sheet1.Columns("i").Values
SolverOk SetCell:="$E$7", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$2:$B$4", _
Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve
Workbooks("Simulated Fresnel Function.xlsx").Activate
Output(i, 1) = Sheet1.Range("B4").Values
Next i
i = 0
' Process the NaCl Data
For i = 1 To 102 Step 1
Workbooks("Calibration Range 1 Normalized Profiles.xlsx").Activate
RawData.Range("C10:C649") = Sheet2.Columns("i").Values
SolverOk SetCell:="$E$7", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$2:$B$4", _
Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve
Workbooks("Simulated Fresnel Function.xlsx").Activate
Output(i, 2) = Sheet1.Range("B4").Values
Next i
i = 0
' Process the Sucrose data
For i = 1 To 72 Step 1
Workbooks("Calibration Range 1 Normalized Profiles.xlsx").Activate
RawData.Range("C10:C649") = Sheet3.Columns("i").Values 'Copies the data of all 'i' columns to raw data for solver
SolverOk SetCell:="$E$7", MaxMinVal:=2, ValueOf:=0, ByChange:="$B$2:$B$4", _
Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve 'Run solver
Workbooks("Simulated Fresnel Function.xlsx").Activate
Output(i, 3) = Sheet1.Range("B4").Values 'Put solver output to the matrix 'output' in the appropriate columns
Next i
End Sub
Related
I am trying to write a triple nested for loop and I get the error message "For Control Variable already in use". I have dimmed and set all the my variables, but it is my first time using a triple nested loop and I can't understand why there is an error. Below my code:
Dim LastrowProv As Integer
Dim LastRowAdv As Integer
LastrowProv = Worksheets("Provisions").Cells(1, 1).End(xlDown).Row
LastRowAdv = Worksheets("Advances").Cells(1, 1).End(xlDown).Row
LastRowCPMatch = Worksheets("Exclusions").Cells(1, CPMatch).End(xlDown).Row
For z = LastRowCPMatch To 1 Step -1
For x = LastrowProv To 2 Step -1
For i = LastRowAdv To 2 Step -1
If Worksheets("Advances").Cells(i, CPNameAdv) = Worksheets("Exclusions").Cells(z, CPMatch) _
And Worksheets("Provisions").Cells(x, CPNameProv) = Worksheets("Exclusions").Cells(z, CPMatch) _
And Worksheets("Advances").Cells(i, IntEntAdv) = Worksheets("Provisions").Cells(x, IntEntProv) _
And Worksheets("Advances").Cells(i, TExpAdv) > -Worksheets("Provisions").Cells(x, TExpProv) Then
Worksheets("Advances").Cells(i, TExpAdv) = Worksheets("Advances").Cells(i, TExpAdv) + Worksheets("Provisions").Cells(x, TExpProv)
Worksheets("Advances").Cells(i, UnsExpAdv) = Worksheets("Advances").Cells(i, UnsExpAdv).Value + Worksheets("Provisions").Cells(x, UnsExpProv).Value
Worksheets("Provisions").Rows(x).EntireRow.Delete
Exit For
End If
Next i
Next x
Next z
Thank you for the help!
Ok, two disclaimers,
I do not work in Vbscript but need to use it a little for an HMI project
I am looking at doing this because this application limits total "tags" or variables
So basically what I am trying to achieve is the following;
a unit8, foo, has the value 5 which is b00000101 now I would like to view this as 8 binary values a pseudocode way of doing this would be
IF foo AND b00000001 <> 0 THEN 'sudo read
.....
foo = foo OR b00000010 'sudo write 1
foo = foo AND b11111101 'sudo write 0
...ect
I think it will be something like
&foo AND &b00000001 <> 0
is this practical in VBScript again I am well aware this is not standard practice but in between tag limitations and HMI input limitations it might actually make the most sense in this application.
You could give something like this a try which uses Bitwise Operators to read and write the bitwise flags.
Function GetFlag(value, bit_num)
Dim bit_mask
If bit_num < 32 Then bit_mask = 2 ^ (bit_num - 1) Else bit_mask = "&H80000000"
GetFlag = CBool(value AND bit_mask)
End Function
Function SetFlag(value, bit_num, new_value)
Dim bit_mask
If bit_num < 32 Then bit_mask = 2 ^ (bit_num - 1) Else bit_mask = "&H80000000"
If new_value Then
SetFlag = value OR bit_mask
Else
bit_mask = NOT bit_mask
SetFlag = value AND bit_mask
End If
End Function
'Define constants to store the flags (maximum of 32)
Const FLAG_SUDOREAD = 1
Const FLAG_SUDOWRITEONE = 2
Const FLAG_SUDOWRITETWO = 3
'Set the flags
Dim options
options = SetFlag(options, FLAG_SUDOREAD, True)
options = SetFlag(options, FLAG_SUDOWRITEONE, False)
options = SetFlag(options, FLAG_SUDOWRITETWO, True)
'Read the flags
WScript.Echo "FLAG_SUDOREAD = " & GetFlag(options, FLAG_SUDOREAD)
WScript.Echo "FLAG_SUDOWRITEONE = " & GetFlag(options, FLAG_SUDOWRITEONE)
Output:
FLAG_SUDOREAD = True
FLAG_SUDOWRITEONE = False
Useful Links
Using Bitwise Operators In VB (Excellent resource for learning Bitwise operators and how to use them)
I have written code which generates a random number between 1-9.
I now want to add to this and generate a random number but generate a new number if that number has already been used before.
Sub main()
Dim max,min
max=9
min=1
Randomize
MsgBox(Int((max-min+1)*Rnd+min))
// Random number between 1-9 is generated
I had tried to implement a loop but i'm unsure of how it would work as i would need to keep the number generated in memory
If Int = random
Msgbox("Already in use")
End If
If Int = not random Then
Msgbox("Can be used")
End If
End Sub
Sounds like you just want to keep track of which random numbers have already been chosen. You could handle this any number of different ways (eg, with an array, hash-table/dictionary, numeric bit mask, etc.)
The solution I present below is similar to a numeric bit mask, but uses a string. Starting at all zeros (eg, "0000"), each indexable position in the string gets populated with a one (1) until the string becomes all ones (eg, "1111"). While potentially oversimplified -- since it assumes your min will always be one (1) -- it should get you started.
Dim min : min=1
Dim max : max=9
Dim result : result = ""
Dim r, s: s = String(max, "0")
Randomize
Do
r = Int((max-min+1)*Rnd+min)
If "0" = Mid(s, r, 1) Then
WScript.Echo "Can be used: " & r
result = result & ":" & r
s = Left(s, r-1) & "1" & Right(s, max-r)
Else
WScript.Echo "Already in use: " & r
End If
Loop Until String(max, "1") = s
WScript.Echo "Result" & result
Sample output:
Can be used: 4
Can be used: 5
Can be used: 9
Can be used: 3
Already in use: 3
Can be used: 1
Can be used: 8
Can be used: 6
Already in use: 6
Can be used: 7
Already in use: 8
Already in use: 4
Already in use: 3
Already in use: 1
Already in use: 6
Can be used: 2
Result:4:5:9:3:1:8:6:7:2
Hope this helps.
I am trying to compare 2 listbox in vb6,list2 items should match items in list1 then remove un-matched strings from list2.
list1 items:
ls-05
ls-06
ls-12
mg_01.rom
mg_02.rom
mg_05.rom
mg_06.rom
mg_m07.rom
mg_m08.rom
mg_m09.rom
mg_m10.rom
mg_m11.rom
mg_m12.rom
mg_m13.rom
mg_m14.rom
list2 items:
ls-05
ls-05.12e
ls-06
ls-06.10e
ls-11
ls-11.2l
ls-12
ls-12.7l
mg_01.rom
mg_02.rom
mg_05.rom
mg_06.rom
mg_m07.rom
mg_m07.rom2
mg_m08.rom
mg_m08.rom3
mg_m09.rom
mg_m09.rom2
mg_m10.rom
mg_m10.rom3
mg_m11.rom
mg_m11.rom0
mg_m12.rom
mg_m12.rom1
mg_m13.rom
mg_m13.rom0
mg_m14.rom
mg_m14.rom1
button code:
For ii = List1.ListCount - 1 To 0 Step -1
For i = List1.ListCount - 1 To 0 Step -1
If List1.List(i) = List2.List(ii) Then Exit For ' no need to keep looping, its a match. i will be > -1
Next
If i = -1 Then ' all items in list1 were searched, but no matches found, so remove it
List2.RemoveItem ii
End If
Next
so the end results I am after is list2 should have same items removing other junk strings that did not match.
Using Strings and InStrB() function:
dim lstitm as string, str2 as string, count as integer
count = list2.listcount
for i = 0 to count - 1
str2 = str2 & list2.list(i) & ";"
next i
list2.clear
count = list1.listcount
for i = 0 to count -1
lstitm = list1.list(i)
if instrb(1,str2,lstitm) <> 0 then list2.additem lstitm
next i
I wanted to write an array of integers to a file.
I have a version that writes bytes to a file. The byte version works perfectly fine.
However, the integer array version does not. It throws the error
"Write failure. Error 1784."
I don't see where I went wrong.
This is the byte version:
Public Function WriteBytes(Buffer() As Byte) As Long
If WriteFile(hFile, _
Buffer(LBound(Buffer)), _
UBound(Buffer) - LBound(Buffer) + 1, _
WriteBytes, _
0) Then
Else
RaiseError HBF_WRITE_FAILURE
End If
End Function
But this one throws an error:
Public Function WriteIntegers(Buffer() As Integer) As Long
Dim lLen&
lLen = (UBound(Buffer) - LBound(Buffer) + 1) * 4 '1 integer=4 bytes
Dim lWritten&
If WriteFile(hFile, _
Buffer(LBound(Buffer)), _
lLen, _
lWritten, _
0) Then
Else
RaiseError HBF_WRITE_FAILURE
End If
WriteIntegers = lWritten
End Function
I am not sure where my error in the integer version is.
Does anybody see it?
Thank you for the help!
lLen = (UBound(Buffer) - LBound(Buffer) + 1) * 4 '1 integer=4 bytes
should be
lLen = (UBound(Buffer) - LBound(Buffer) + 1) * 2