Basic4Android shuffle code - basic

Basically I need this Visual Basic code translated to Basic4Android code.
What I want to do is to randomly assign to 16 buttons values from 1-15 and one empty. Each time they will be different. I've done it in VB and it works but know I want to make this on Android.
Sub Shuffle()
Dim a(15), i, j, RN As Integer
Dim flag As Boolean
flag = False
i = 1
a(j) = 1
Do While i <= 15
Randomize()
RN = CInt(Int((15 * Rnd()) + 1))
For j = 1 To i
If (a(j) = RN) Then
flag = True
Exit For
End If
Next
If flag = True Then
flag = False
Else
a(i) = RN
i = i + 1
End If
Loop
Form1.Button1.Text = a(1)
Form1.Button2.Text = a(2)
Form1.Button3.Text = a(3)
Form1.Button4.Text = a(4)
Form1.Button5.Text = a(5)
Form1.Button6.Text = a(6)
Form1.Button7.Text = a(7)
Form1.Button8.Text = a(8)
Form1.Button9.Text = a(9)
Form1.Button10.Text = a(10)
Form1.Button11.Text = a(11)
Form1.Button12.Text = a(12)
Form1.Button13.Text = a(13)
Form1.Button14.Text = a(14)
Form1.Button15.Text = a(15)
Form1.Button16.Text = ""
End Sub
I know only to change "Integer" to "Int" and delete all "Form1's". I can't use Randomize() nor CInt nor Int statements because they give me errors.

Hope this helps. its code for getting random number without repeating.
you can change i as per your requirement.
Sub Activity_Create(FirstTime As Boolean)
dim l as list
l.Initialize
Dim i As Int = 1
Do While i < 17
Dim x As Int
x = Rnd(1,17)
If l.IndexOf(x) = -1 Then
l.Add(x)
i = i + 1
Else
Log("DUPLICATE:" & x)
End If
Loop
For i = 0 To l.Size -1
Log(l.Get(i))
Next
End Sub

Related

Mismatch error in VBA - problems with columns

I have a workbook where I want to find the differences of two sheets by looking at the company name and their corporate registration number and then type the differences on the third sheet.
I have tried the code in another workbook with only 143 rows, which works perfectly, but when I try it on the real workbook with 10,000 rows I get a "type mismatch error". Also if I use other columns than the CVR and Firm columns the code also works.
The CVR is numbers and Firms are strings (firm names). I get the
type mismatch error
on the line I marked **. Does somebody know why I get this error?
Sub ComCVR()
Dim CVR1()
Dim CVR2()
Dim Firm1()
Dim Firm2()
Dim n As Long, m As Long
Dim i As Double, j As Double
Dim intCurRow1 As Integer, intCurRow2 As Integer
Dim rng As Range, rng1 As Range
Set rng = ThisWorkbook.Sheets("Last month").Range("A11")
Set rng1 = ThisWorkbook.Sheets("Current month").Range("A11")
n = rng.CurrentRegion.Rows.Count
m = rng1.CurrentRegion.Rows.Count
ReDim CVR1(n)
ReDim Firm1(n)
ReDim CVR2(m)
ReDim Firm2(m)
ThisWorkbook.Sheets("CVR").Range("A1") = "Flyttet CVR"
ThisWorkbook.Sheets("CVR").Range("B1") = "Flyttet Firmanavn"
ThisWorkbook.Sheets("CVR").Range("A1:B1").Interior.ColorIndex = 3
ThisWorkbook.Sheets("CVR").Range("C1") = "Nye CVR"
ThisWorkbook.Sheets("CVR").Range("D1") = "Nye Firmanavn"
ThisWorkbook.Sheets("CVR").Range("C1:D1").Interior.ColorIndex = 4
ThisWorkbook.Sheets("CVR").Range("A1:D1").Font.Bold = True
' Inset data to arrays
For i = 0 To n
CVR1(i) = ThisWorkbook.Sheets("Last month").Cells(12 + i, 5)
Firm1(i) = ThisWorkbook.Sheets("Last month").Cells(12 + i, 4)
Next
For i = 0 To m
CVR2(i) = ThisWorkbook.Sheets("Current month").Cells(12 + i, 5)
Firm2(i) = ThisWorkbook.Sheets("Current month").Cells(12 + i, 4)
Next
intCurRow1 = 2
intCurRow2 = 2
'Old
For i = 0 To n
For j = 0 To m
If Firm1(i) = ThisWorkbook.Sheets("Current month").Cells(12 + j, 4) Then '** Error raised here
Exit For
End If
If j = m Then
ThisWorkbook.Sheets("CVR").Cells(intCurRow1, 1) = CVR1(i)
ThisWorkbook.Sheets("CVR").Cells(intCurRow1, 2) = Firm1(i)
intCurRow1 = intCurRow1 + 1
End If
Next j
Next i
'new
For i = 0 To m
For j = 0 To n
If Firm2(i) = ThisWorkbook.Sheets("Last month").Cells(12 + j, 4) Then
Exit For
End If
If j = n Then
ThisWorkbook.Sheets("CVR").Cells(intCurRow2, 3) = CVR2(i)
ThisWorkbook.Sheets("CVR").Cells(intCurRow2, 4) = Firm2(i)
intCurRow2 = intCurRow2 + 1
End If
Next j
Next i
Columns("A:B").Select
ActiveSheet.Range("$A:$B").RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = False
Columns("C:D").Select
ActiveSheet.Range("$C:$D").RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = False
End Sub
Whenever an error happens, the best way is to google it. This is what it says in the documentation of VBA for Type mismatch:
Cause: The variable or property isn't of the correct type. For example, a variable that requires an integer value can't accept a string value unless the whole string can be recognized as an integer.
In the case of the code, it happens, when an array is compared with excel cell. Now the trick - in order to see why it happens, see what is in these:
Debug.Print ThisWorkbook.Sheets("Last month").Cells(12 + i, 4)
Debug.Print Firm1(i)
and the after the error runs, take a look at the immediate window (Ctrl+G). It it quite possible, that there is an error in the excel cell, thus it cannot be compared. This is some easy way to avoid it, if this is the case:
Sub TestMe()
Dim myRange As Range
Set myRange = Worksheets(1).Cells(1, 1)
myRange.Formula = "=0/0"
If Not IsError(myRange) Then
Debug.Print CBool(myRange = 2)
Else
Debug.Print myRange.Address; " is error!"
End If
End Sub

Array of ranges no longer being set successfully after adding a range declaration on the same line

The code is falling down on the line If snake(i).Column = 10 Then
with the Runtime error 424, Object required. Upon checking for the existence of the range snake(i) where i = 3, there is none, but I cannot see why this range array and the other one that it relies on, box(), are not being set properly.
Context: As a personal challenge and to improve my understanding of VBA, I recreated a game of Snake from scratch in Excel. It was working perfectly fine until I started to add in some code, seen at the very bottom of the quote below, in order to add the occasional greater-value food items. I don't understand how code from further down can stop code further up from functioning how it used to. The only changes made to the code above the error line since the working version are the two variables applesEaten and gAppleCountdown which seem to me completely straightforward. Edit: I also added the declaration of the range goldenApple, which it turned out is the cause of the error.
Dim wb As Workbook
Dim ws, scoreSheet As Worksheet
Set wb = ActiveWorkbook
Set ws = wb.Worksheets(1)
Set scoreSheet = wb.Worksheets(2)
Dim box(1 To 100) As Range
Dim vert, hori, i, step, re, rand, randResult, timeLoop, snakeHeadCol, snakeHeadRow, score, applesEaten, gAppleCountdown, speed, lastRow As Long
Dim snake(), goldenApple As Range
ReDim snake(1 To 3)
re = 3
speed = scoreSheet.Cells(2, 12).Value
applesEaten = 0
gAppleCountdown = 0
score = 0
For vert = 1 To 10
For hori = 1 To 10
Set box(hori + 10 * (vert - 1)) = ws.Cells(vert, hori)
Next
Next
For i = 1 To 100
box(i) = ""
Next
Set snake(1) = box(44)
Set snake(2) = box(45)
Set snake(3) = box(46)
For i = LBound(snake) To UBound(snake)
snake(i) = 1
Next
box(49) = 2
step = 1
Do Until WorksheetFunction.Sum(ws.Range("A1:J10")) >= 101
i = UBound(snake)
Select Case direction
Case 1
If snake(i).Column = 10 Then
If snake(i).Offset(0, -9) = 2 Or snake(i).Offset(0, -9) = 0.2 Then
If snake(i).Offset(0, -9).Address = goldenApple.Address Then
score = score + gAppleCountdown
Set goldenApple = ws.Cells(11, 11)
Else
score = score + 1
applesEaten = applesEaten + 1
rand = Int((100 - 1 + 1) * Rnd + 1)
randResult = rand
Do While box(randResult) = 1
rand = Int((100 - 1 + 1) * Rnd + 1)
randResult = rand
Loop
box(randResult) = 2
End If
re = re + 1
ReDim Preserve snake(1 To re)
Set snake(re) = snake(re - 1).Offset(0, -9)
snake(re) = 1
If applesEaten Mod 5 = 0 Then
rand = Int((100 - 1 + 1) * Rnd + 1)
randResult = rand
Do While box(randResult) = 1
rand = Int((100 - 1 + 1) * Rnd + 1)
randResult = rand
Loop
Set goldenApple = box(randResult)
goldenApple = 0.2
gAppleCountdown = 5
ws.Cells(1, 11) = gAppleCountdown
Else
End If
ws.Cells(23, 5) = score
With thanks to Damian, for explaining in the comments, the problem was the line
Dim snake(), goldenApple As Range
This is equivalent to
Dim snake()
Dim goldenApple As Range
when what is really required is
Dim snake() As Range, Dim goldenApple As Range
or
Dim snake() As Range
Dim goldenApple As Range
Declarations of type Dim snake() by default provide for variants.

Find if the number is Prime or show the prime factors using excel formula?

I have of integers in Col A and in col B i want to show result 'Prime' if it doesn't have further factors for the number itself. This goes like this if the number for example is 37 result will be 'Prime' and if its 44 then result will be 2x2x11. How can i do this using excel formula? Screen shot :
Disclaimer: code below is ported from this very useful VB.NET example
Option Explicit
Sub Test()
Debug.Print FindFactors(2)
Debug.Print FindFactors(3)
Debug.Print FindFactors(11)
Debug.Print FindFactors(12)
Debug.Print FindFactors(13)
Debug.Print FindFactors(16)
Debug.Print FindFactors(17)
Debug.Print FindFactors(24)
Debug.Print FindFactors(25)
Debug.Print FindFactors(11234)
Debug.Print FindFactors(67894)
End Sub
Function FindFactors(lngNumber As Long) As String
Dim collFactors As Collection
Dim lngFactor As Long
Dim lngCounter As Long
Dim strFactors As String
Dim strFactor As String
Set collFactors = New Collection
' Take out the 2s.
Do While (lngNumber Mod 2 = 0)
collFactors.Add 2
lngNumber = lngNumber / 2
Loop
' Take out other primes.
lngFactor = 3
Do While (lngFactor * lngFactor <= lngNumber)
If (lngNumber Mod lngFactor = 0) Then
' This is a factor.
collFactors.Add lngFactor
lngNumber = lngNumber / lngFactor
Else
' Go to the next odd number.
lngFactor = lngFactor + 2
End If
Loop
' If num is not 1, then whatever is left is prime.
If lngNumber > 1 Then
collFactors.Add lngNumber
End If
' make a string out of collection
strFactors = ""
If collFactors.Count = 1 Then
strFactors = "Prime"
Else
For lngCounter = 1 To collFactors.Count
strFactors = strFactors & collFactors(lngCounter)
If lngCounter < collFactors.Count Then
strFactors = strFactors & "x"
End If
Next lngCounter
End If
FindFactors = strFactors
End Function
Gives an output of:
Prime
Prime
Prime
2x2x3
Prime
2x2x2x2
Prime
2x2x2x3
5x5
2x41x137
2x83x409
Can be used in a worksheet:
Here is a somewhat straightforward recursive version. It is based on the idea that once you identify a factor you divide the number by that factor and then turn your attention to factoring the rest.
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "x" & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
Output:
Using LET and dynamic arrays allows for the following without VBA.
=LET(x, SEQUENCE(A1),
factors, FILTER(x, MOD(A1,x) = 0),
factorMatrix, 1 * (MOD(factors, TRANSPOSE(factors)) = 0),
primeFactors, FILTER(factors, MMULT(factorMatrix, factors ^ 0) = 2),
primeFactorList, IF(MOD(A1, primeFactors ^ SEQUENCE(1, 20)) = 0, primeFactors, ""),
factorProduct, TEXTJOIN("x",, primeFactorList),
IF(A1 = 1, "Neither", IF(factorProduct=A1&"","Prime",factorProduct)))
It works for numbers up to 2^20.
A slight modification to the excellent code of John Coleman above, using Mod with Doubles included below, will allow factoring integers up to Excel's 15 digit limit. Numbers with large factors may be noticeably slower. For example, 562,951,983,465,953 factored correctly as 16,777,259 x 33,554,467 in about 5 seconds on a Core i3.
Function Factor(ByVal n As Double, Optional FirstTrial As Double = 2) As String 'Changed
Dim i As Long
Dim t As Double 'Changed
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If FMod(t, n) = 0 Then 'Changed
.
.
.
Public Function FMod(a As Double, b As Double) As Double
FMod = a - Fix(a / b) * b
'http://en.wikipedia.org/wiki/Machine_epsilon
'Unfortunately, this function can only be accurate when `a / b` is outside [-2.22E-16,+2.22E-16]
'Without this correction, FMod(.66, .06) = 5.55111512312578E-17 when it should be 0
If FMod >= -2 ^ -52 And FMod <= 2 ^ -52 Then '+/- 2.22E-16
FMod = 0
End If
End Function

Dynamically adding nested loops

I have an 'X' amount of variables (likely to range between 3 to 20 options), which will be combined to calculate all possible combinations to meet a criteria. For every extra variable an extra loop is introduced, however I do not know if it possible to make the creation of loops dynamic (in excel VBA, the code doesn't have to be very fast).
To demonstrate:
I have var. A with h = 2, var. B with h = 3.
I would like to know all combinations which are equal to 10 or the best combination of the 2 variables.
In this case: option 1 = 5*A = 10, 3*B = 9,2*A and 2*B = 10, 3*A and 1*B = 9.
The code looks like this:
For A = 0 to 5
h = 0 'Reset previous h if solution is found
For B = 0 to 5
h_test = A * height(A) + B * heigth(B)
if h_test > 10
if h = 0 then
exit for
else
write h
exit for
end if
h = h_test
Next B
Next A
If another parameter is introduced (for example C = 4), the code is:
For A = 0 to 5
h = 0 'Reset previous h if solution is found
For B = 0 to 5
h = 0 'Reset previous h if solution is found
For C = 0 to 5
h_test = A * height(A) + B * heigth(B) + C * heigth(C)
if h_test > 10
if h = 0 then
exit for
else
write h
exit for
end if
h = h_test
Next C
Next B
Next A
In other words, I would like to know if it is possible to translate the pseudocode to real code:
For #parameter. = X
For loop1 = 1 to 5
h = 0
For loop2 = 1 to 5
h = 0
....
For loopX = 1 to 5
h_test = loop1 *parameter1 + loop2 * parameter 2 ...
+ loopX * parameter X
If h_test > 10
Somecode
exit for
End if
Next X
...
Next loop2
Next loop1
There are two distinct problems here. You didn't mention the first, and that is you also need to calculate a value with an indeterminate number of arguments. For that, you can use a ParamArray.
For example:
Public Function Sum(ParamArray args() As Variant) As Long
Dim i As Long
Dim operand As Integer
Dim result As Long
For i = LBound(args) To UBound(args)
result = args(i) + result
Next i
Sum = result
End Function
Which can be used and tested like this:
Public Sub Test()
Debug.Print Sum(1,2) '=> 3
Debug.Print Sum(1,2,3) '=> 6
End Sub
So, that takes care of that problem. Now, as for the problem you asked about, we'll take a similar approach. The key is to loop once for each argument you've received.
Public Sub Run()
NestedLoop 1, 2, 3
End Sub
Public Sub NestedLoop(ParamArray args() As Variant)
Dim result As Long
Dim a As Variant
a = args
Dim h_test As Long
Dim i As Long, j As Long
For i = LBound(args) To UBound(args)
For j = 1 To 5
result = 0
h_test = Sum(a)
If h_test > 10 Then
If result = 0 Then
Exit For
Else
Debug.Print result
Exit For
End If
End If
result = h_test
Next j
Next i
End Sub
Public Function Sum(args As Variant) As Long
Dim i As Long
Dim operand As Integer
Dim result As Long
For i = LBound(args) To UBound(args)
result = args(i) + result
Next i
Sum = result
End Function

Long Datatype Overflow

I am trying to do some prime factorisation with my VBA excel and I am hitting the limit of the long data type -
Runtime Error 6 Overflow
Is there any way to get around this and still stay within VBA? I am aware that the obvious one would be to use another more appropriate programming language.
Lance's solution works in so far that I am able to get the big numbers into the variables now. However, when I try to apply the MOD function - bignumber MOD 2, for example - it still fails with error message
Runtime Error 6 Overflow
You can use Decimal data type. Quick hint from google: http://www.ozgrid.com/VBA/convert-to-decimal.htm
This is my Decimals.cls (VB6):
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "Decimals"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
'local variable(s) to hold property value(s)
Private mvarDec As Variant 'local copy
Public Property Let Dec(ByVal vData As Variant)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Dec = 5
mvarDec = CDec(vData)
End Property
Public Property Get Dec() As Variant
Attribute Dec.VB_UserMemId = 0
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Dec
Dec = CDec(mvarDec)
End Property
and this is a testing program. The class has been setup so that you don't have to qualify with .Dec() on get and let.
Dim dec1 As New Std.Decimals
Dim dec2 As New Std.Decimals
Dim dec3 As New Std.Decimals
Dim modulus As New Std.Decimals
Sub main()
dec1 = "1000.000000001"
dec2 = "1000.00000000000001"
dec3 = dec1 + dec2
Debug.Print dec1
Debug.Print dec2
Debug.Print dec3
Debug.Print dec3 * dec3
Debug.Print dec3 / 10
Debug.Print dec3 / 100
Debug.Print Sqr(dec3)
modulus = dec1 - Int(dec1 / dec2) * dec2
Debug.Print modulus
End Sub
and sample run
1000.000000001
1000.00000000000001
2000.00000000100001
4000000.000004000040000001
200.000000000100001
20.0000000000100001
44.721359550007
0.00000000099999
1000.000000001
1000.00000000000001
2000.00000000100001
4000000.000004000040000001
200.000000000100001
20.0000000000100001
44.721359550007
0.00000000099999
Here is my "big multiply" routine for multiplying arbitrarily large numbers (eg 100 characters long). It works by splitting the input numbers, which are strings, into chunks of 7 digits (because then it can cross multiply them and store the results in Doubles).
eg bigmultiply("1934567803945969696433","4483838382211678") = 8674289372323895422678848864807544574
Function BigMultiply(ByVal s1 As String, ByVal s2 As String) As String
Dim x As Long
x = 7
Dim n1 As Long, n2 As Long, n As Long
n1 = Int(Len(s1) / x + 0.999999)
n2 = Int(Len(s2) / x + 0.999999)
n = n1 + n2
Dim i As Long, j As Long
ReDim za1(n1) As Double
i = Len(s1) Mod x
If i = 0 Then i = x
za1(1) = Left(s1, i)
i = i + 1
For j = 2 To n1
za1(j) = Mid(s1, i, x)
i = i + x
Next j
ReDim za2(n2) As Double
i = Len(s2) Mod x
If i = 0 Then i = x
za2(1) = Left(s2, i)
i = i + 1
For j = 2 To n2
za2(j) = Mid(s2, i, x)
i = i + x
Next j
ReDim z(n) As Double
Dim u1 As Long, u2 As Long
Dim e As String
e = String(x, "0")
For u1 = 1 To n1
i = u1
For u2 = 1 To n2
i = i + 1
z(i) = z(i) + za1(u1) * za2(u2)
Next u2
Next u1
Dim s As String, y As Double, w As Double, m As Long
m = n * x
s = String(m, "0")
y = 10 ^ x
For i = n To 1 Step -1
w = Int(z(i) / y)
Mid(s, i * x - x + 1, x) = Format(z(i) - w * y, e)
z(i - 1) = z(i - 1) + w
Next i
'truncate leading zeros
For i = 1 To m
If Mid$(s, i, 1) <> "0" Then Exit For
Next i
If i > m Then
BigMultiply = ""
Else
BigMultiply = Mid$(s, i)
End If
End Function
MOD is trying to convert your DECIMAL type to LONG before operating on it. You may need to write your own MOD function for the DECIMAL type. You might try this:
r = A - Int(A / B) * B
where A & B are DECIMAL subtype of VARIANT variables, and r might have to be that large also (depending on your needs), though I only tested on a long.

Resources