I get a Subscript out of range error when I try to write it this way (this is just pseudo for the logic):
Dim var As Double
Dim arr() As Variant
Dim var_arr() As Variant
Dim z As Integer
z = 3
arr = Range(Cells(2, 1), Cells(150000, 4))
var_arr = Range(Cells(2, 1), Cells(10000, 1))
Dim i As Long
For i = 1 to 10000
var = var_arr(i)
'arr(var, 3) is 0 and double before I try to write it
'and var is part of arr and there aren't any duplicates
If IsInArray(var, arr) = True Then
arr(var, 3) = z
End If
Next i
PrintArray arr, ActiveWorkbook.Worksheets("Sheet1").[A2]
Doing this in a worksheet is unfortunately not an option because it would took forever.
Here is the full code:
Sub WRITELAYERID()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Sheets("MINTA").Activate
Dim MINTA_array() As Variant
MINTA_array = Range(Cells(2, 1), Cells(46643, 4))
Sheets("ALAP").Activate
Dim ALAP_array() As Variant
ALAP_array = Range(Cells(2, 1), Cells(16482, 5))
Dim z As Long
For z = 1 To 14
Dim col As New Collection
Dim lastRow As Long
Dim ID_array() As Variant
Dim x As Long
For x = 1 To 16481
DoEvents
If ALAP_array(x, 2) = z Then
Dim a As Long
Dim c As Long
Dim d As Long
a = ALAP_array(x, 1)
c = ALAP_array(x, 3)
d = ALAP_array(x, 4)
Dim i As Long
i = c
Do While i <= d
Dim ID_sample_string As String
Dim ID_sample_number As Long
Dim e As String
If i < 10 Then
e = 0 & i
Else
e = i
End If
ID_sample_string = a & e
'ID_sample_number = CLng(ID_sample_string)
'Excel 2010 function:
ID_sample_number = CLng(Val(ID_sample_string)) 'Val is black not blue... maybe it is not working properly?
col.Add ID_sample_number 'add to collection
i = i + 1
Loop
End If
Next x
ID_array = toArray(col) 'function: convert collection to an array
Dim ID_array_Rows As Integer
ID_array_Rows = UBound(ID_array, 1) - LBound(ID_array, 1) + 1
Dim h As Integer
For h = 1 To ID_array_Rows
DoEvents
Dim ID_sample As Double
ID_sample = ID_array(h)
If IsInArray(ID_sample, MINTA_array) = True Then 'function
'MsgBox (VarType(ID_sample)) --> double
'MsgBox (VarType(MINTA_array(1, 3))) --> double
MINTA_array(ID_sample, 3) = MINTA_array(ID_sample, 3) + z 'HERE is the problem
'End If
Next h
Next z
PrintArray MINTA_array, ActiveWorkbook.Worksheets("KESZ").[A2] 'function
End Sub
This is the IsInArray function:
Private Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
'DEVELOPER: Ryan Wells (wellsr.com)
'DESCRIPTION: Function to check if a value is in an array of values
'INPUT: Pass the function a value to search for and an array of values of any data type.
'OUTPUT: True if is in array, false otherwise
Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
For Each element In arr
If element = valToBeFound Then
IsInArray = True
Exit Function
End If
Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function
Link of my tables with examples: https://i.stack.imgur.com/uAWNp.jpg Table 1 is ALAP, Table 2 is MINTA
