Using a sub to call an array within a function - arrays

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

Related

Loop in range of cells with fixed last row

I need to loop in a range (in my case column A) to get following results:
A B
1 = 2 - 1
2 = 3 - 1
3 = 3 - 2
4 = 4 - 1
5 = 4 - 2
= 4 - 3
= 5 - 1
= 5 - 2
= 5 - 3
= 5 - 4
I want number 5 to be deducted by 4, 3, 2 ,1 and then number 4 by 3, 2, 1 and so on.
I was somehow able to achieve this with collection but since dataset is rather big script is running 30+ minutes.
At this point I'm trying to figure out arrays but I don't know how to get desired result. My main concern is whether I can loop from bottom to top (From number 5 to 1, not 1 to 5) and how to fixate last row (fix number 5, conduct deductions and then fix number 4, do math magic and loop to 3 and so on).
My current code is:
Dim Arr As Variant
Dim lastc, lastr As Long
lastc = FindColNumber
lastr = ws.Cells(ws.Rows.count, lastc).End(xlUp).Row
Arr = ws.Range(ws.Cells(2, last), ws.Cells(lastr, lastc))
For i = LBound(Arr, 1) To UBound(Arr, 1) - 1
If (Arr(i, 1) > 0) And (Arr(i + 1, 1) > Arr(i, 1)) Then
Arr(i, 1) = Arr(i, 1) - Arr(i + 1, 1)
Code does deduction as following: 5-4, 4-3, 3-2, 2-1 and that's not what I need.
Any tips?
Thank you.
As stated in the comments, you will need two loops and another output array:
Sub lkjlkjkdl()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim Arr As Variant
Dim lastc As Long, lastr As Long
lastc = 1 'FindColNumber
lastr = ws.Cells(ws.Rows.Count, lastc).End(xlUp).Row
Arr = ws.Range(ws.Cells(2, lastc), ws.Cells(lastr, lastc))
Dim cnt As Long
cnt = ((UBound(Arr, 1) - 1) * UBound(Arr, 1)) / 2
Dim k As Long
k = 1
Dim outarr As Variant
ReDim outarr(1 To cnt, 1 To 1)
For i = LBound(Arr, 1) + 1 To UBound(Arr, 1)
Dim j As Long
For j = LBound(Arr, 1) To i - 1
outarr(k, 1) = Arr(i, 1) - Arr(j, 1)
k = k + 1
Next j
Next i
ws.Range("B2").Resize(cnt, 1).Value = outarr
End Sub

vba loop through array, store values to arrayi

I have some data, stored in arrays like
Dim arrA, arrB, arrC, arrAi, arrBi
Dim i as integer, x as integer
for i = 1 to 100
if cells(i,1).value = "criteria" then ' just add value to array when it meets some criteria
x = x + 1
arrA(x) = cells(i,1).value
arrB(x) = cells(i,2).value
arrC(x) = cells(i,3).value
end if
next i
redim preserve arrA(1 to x)
redim preserve arrB(1 to x)
redim preserve arrC(1 to x)
And the data looks like
arrA: 26.1 40.2 80.3 26.0 41.3 78.7 25.8 40.8 80.0
arrB: 10 11 10 66 67 64 32 32 33
arrC: 1 2 3 1 2 3 1 2 3
Since the values in arrA 26.1, 26.0, 25.8 (position 1, 4, 7) belong to group 1 (referencing to values in arrC at same position), I would like to store 26.1 26.0 25.8 to arrAi and 10 66 32 to arrBi for subsequent calculations.
How can I loop through the 3 arrays and store values to another array as described above?
Thanks in advance.
Try the next way, please:
Sub handleArraysFromArrays()
'your existing code...
'but you fistly must declare
Dim arrA(1 To 100), arrB(1 To 100), arrC(1 To 100)
'....
'your existing code
'...
Dim k As Long, kk As Long
ReDim arrAi(1 To UBound(arrA))
ReDim arrBi(1 To UBound(arrA))
For i = 1 To UBound(arrC)
If arrC(i, 1) = 1 Then k = k + 1: arrAi(k, 1) = arrA(i, 1)
If arrC(i, 1) = 2 Then kk = kk + 1: arrBi(kk, 1) = arrA(i, 1)
Next i
ReDim Preserve arrAi(1 To k): ReDim Preserve arrBi(1 To kk)
Debug.Print UBound(arrAi), UBound(arrBi)
End Sub

Change Array in VBA

I want to swap values into a multidimensional array which are not #N/A or not 0 for each row. So the input table is on a spreadsheet with contains the numbers below, the problem is I can't swap them how I want.
24 20 0 #N/A #N/A #N/A
21 20 0 #NA #N/A #N/A
25 24 20 0 #N/A #N/A
26 25 24 20 0 #N/A
28 26 25 24 20 0
Do you have any suggestion how to deal with that?
Sub FlipRows()
Dim Rng As Range
Dim WorkRng As Range
Dim arr As Variant
Dim i As Integer, j As Integer, k As Integer
Dim matrix As Range, matrix2 As Range
Set matrix = Range("A1:F5")
Set matrix2 = Range("A7:F11")
'Set tempMatrix as String, tempMatrix2 as String
On Error Resume Next
'matrix.Select
'matrix.Copy
'matrix2.Select
'matrix2.PasteSpecial
Set WorkRng = Application.Selection
arr = WorkRng.Formula
For i = 1 To UBound(arr, 1)
k = UBound(arr, 2)
For j = 1 To UBound(arr, 2) / 2
xTemp = arr(i, j)
arr(i, j) = arr(i, k)
arr(i, k) = xTemp
k = k - 1
Next
Next
WorkRng.Formula = arr
End Sub
Assuming you invalid values (0 and #NA) are always on the right of each row, this should do:
For i = LBound(arr, 1) To UBound(arr, 1)
'first search backward the first valid entry
For k = UBound(arr, 2) To LBound(arr, 2) Step -1
If Not IsError(arr(i, k)) Then If arr(i, k) <> 0 And arr(i, k) <> "#NA" Then Exit For
Next
'Now do the swap in the valid region
For j = LBound(arr, 2) To Int(k / 2)
Dim temp: temp = arr(i, j)
arr(i, j) = arr(i, LBound(arr, 2) + k - j)
arr(i, LBound(arr, 2) + k - j) = temp
Next
Next
WorkRng.Formula = arr
Assuming you always have a zero value after the values you want to swap
Sub swap()
Set r = Range("A1:F5")
For Each ro In r.Rows
Set re = ro.Find(0, lookat:=xlWhole)
co = re.Column
For c = 1 To (co - 1) / 2
a = ro.Cells(1, c)
ro.Cells(1, c) = ro.Cells(1, co - c)
ro.Cells(1, co - c) = a
Next c
Next ro
End Sub

Multiplying two dimensional arrays

how to multiply two dimensional a(5,3) and b (3,5)
so the arry c( , )= a(5,3) and b (3,5)
the first row of arry a * the columns of arry b then
the second row of arry a * the columns of arry b then
[EDIT] the code of your comment:
Dim arry1(5, 3) As Integer
Dim arry2(3, 5) As Integer
Dim i, j As Integer
For i = 1 To 5
For j = 1 To 3
arry1(i, j) = Int(9 * Rnd + 1)
Next i, j
For i = 1 To 3
For j = 1 To 5
arry2(i, j) = Int(9 * Rnd + 1)
Next i, j
Congrats! it works :)
Some comments:
when you use Dim a, b As Integer then b will be an Integer, but a will be a Variant. It is better to use Dim a As Integer, b As Integer so that both a and b will be Integers
why do you ReDim c(5, 5) As Integer ? You can use Dim c(5, 5) As Integer
Instead of printing to the form I would show the data in a textbox or label control
Dim a, b As Integer
Dim arry1(5, 3) As Integer
Dim arry2(3, 5) As Integer
ReDim c(5, 5) As Integer
Dim i, j, s As Integer
Print ""
Print Space(15); "the first arry"
Print ""
For i = 1 To 5
For j = 1 To 3
arry1(i, j) = Int(9 * Rnd + 1)
Print Space(3); arry1(i, j);
Next j
Print ""
Next i
Print ""
Print Space(15); " the second arry"
Print ""
For i = 1 To 3
For j = 1 To 5
arry2(i, j) = Int(9 * Rnd + 1)
Print Space(3); arry2(i, j);
Next j
Print ""
Next i
Print ""
Print Space(15); " the result"
Print ""
cmd1.Visible = False
For a = 1 To 5
For b = 1 To 5
For j = 1 To 3
s = s + (arry1(b, j) * arry2(j, a))
c(a, b) = s
Next j
s=0
Next b
Next a
For i = 1 To 5
For j = 1 To 5
Print Space(3); c(i, j);
Next j
Print ""
Next i
thank you for your answers i solved the problem by may self and its pleasure me if you tel your openion in my code ... thank you

Input/output values into an array

EDIT: Updated question using some of the suggestions below. This produces weird output though.
Dim ProviderArray() As Variant
Sub GetProviderNumbers()
Dim InputRange As Range
Dim WorkRange As Range
Set InputRange = Range("ProviderList")
Set WorkRange = Application.Intersect(InputRange, ActiveSheet.UsedRange)
SizeOfArray = Application.WorksheetFunction.CountA(WorkRange)
ReDim ProviderArray(0 To SizeOfArray)
ProviderArray = WorkRange.Value
For r = 1 To UBound(ProviderArray, 1)
For C = 1 To UBound(ProviderArray, 2)
Debug.Print r, C, ProviderArray(r, C)
Next C
Next r
End Sub
1 1 5555
2 1 4444654
3 1 654654
4 1 654654654
5 1
6 1
7 1
8 1
9 1
10 1
11 1
12 1
13 1
14 1
15 1
16 1
17 1
18 1
19 1
Could someone explain why this output?
You can only use the one-line approach if you put the range into a 2-D array: you only have a 1-D array.
You could do this:
Dim ProviderArray()
Set WorkRange = .Intersect(InputRange, ActiveSheet.UsedRange)
'This makes ProviderArray a 2-D array, dimension 1 = # rows,
' dimension2 = #cols. Both dimensions are 1-based.
ProviderArray = WorkRange.value
for r=1 to ubound(ProviderArray,1)
for c=1 to ubound(ProviderArray,2)
debug.print r,c,ProviderArray(r,c)
next c
next r
Maybe something a bit simpler like:
Private Sub GetProviderNumbers()
Dim InputRange() As Variant
InputRange = Range("ProviderList")
For Each i In InputRange
Debug.Print i
Next
End Sub
This captures a two-dimensional range and stores the values in a global two-dimensional array:
Dim ProviderArray() As String
Sub MAIN()
Range("B2:C11").Name = "ProviderList"
Call GetProviderNumbers
End Sub
Sub GetProviderNumbers()
ary = Range("Providerlist")
ll = LBound(ary, 1)
lm = LBound(ary, 2)
ul = UBound(ary, 1)
um = UBound(ary, 2)
ReDim ProviderArray(ll To ul, lm To um)
For i = ll To ul
For j = lm To um
ProviderArray(i, j) = ary(i, j)
Next
Next
End Sub

Resources