Array - Subscript out of range..

[Mallesh23]

Hi Team,

Unable to store data into Array getting subscript out of range.
Adding data in dictionary, storing output in array, and printing array in Range.

My data is in 150000 rows. so trying array and Dictionary Combination.

Expected output is in H and I Columns.
'Below attempted Code.

Sub Dict_array_Combination()

    Dim dict As New Scripting.dictionary
    Dim arr As Variant
    Dim i As Long
    Dim ary As Variant
   
    arr = Range("A2:D13").Value
   
       Dim ary_english As Variant
        Dim ary_Maths As Variant
   
        ary_english = Range("G2:G10").Value
        ary_Maths = Range("G2:G10").Value
   
   
    'Store in Dictionary
    With dict
        For i = LBound(arr, 1) To UBound(arr, 1)
            If Not .Exists(arr(i, 1)) Then
                .Add (arr(i, 1)), Array(arr(i, 2), arr(i, 4))
            End If
        Next i
   
    'Store Output in Array     'Can we store two columns into array.
        For i = LBound(ary_english, 1) To UBound(ary_english, 1)
              ary_english(i, 1) = .Item(ary_english(i, 1))  'Store English Marks.
              ary_Maths(i, 1) = .Item(ary_Maths(i, 4))  ' 'Store Maths Marks.
        Next i
    
    End With
    
    'Print Array Output in Range
    Range("H2").Resize(UBound(ary_english, 1)).Value = ary_english 'Print english Marks
    Range("I2").Resize(UBound(ary_Maths, 1)).Value = ary_Maths ''Print Maths Marks
    

End Sub

Book1
	A	B	C	D	E	F	G	H	I
1	Student	English	Hindi	Math			Student	English	Math
2	Salman	57	72	58			Salman	57	58
3	Shahrukh	91	52	50			Shahrukh	91	50
4	Hrithik	87	86	76			Hrithik	87	76
5	Priyanka	80	74	75			Priyanka	80	75
6	Katrina	79	84	92			Katrina	79	92
7	Alia	74	53	76			dharmendra
8	Madhuri	61	57	80			Madhuri	61	80
9	Amir	77	80	70			Amir	77	70
10	Amitabh	81	71	79			Govinda
11	Johny Lever	71	80	72			Amitabh	81	79
12	Juhi	71	80	72
13	Karishma	65	85	75
Sheet1

Cell Formulas
Range	Formula
H2:H11	H2	=IFERROR(VLOOKUP(G2,$A$1:$D$13,2,0),"")
I2:I11	I2	=IFERROR(VLOOKUP(G2,$A$1:$D$13,4,0),"")

 

[Fluff]

Which line gives the error?

 

[Mallesh23]

Hi Fluff,

Below line , throwing error.
ary_Maths(i, 1) = .Item(ary_Maths(i, 4)) ' 'Store Maths Marks.

This line works.
ary_english(i, 1) = .Item(ary_english(i, 1)) 'Store English Marks.

also I am not sure how to store two values in array and print.


Thanks for your help in advance.


Thanks
mg

 

[Fluff]

Your ary_Maths is only one column wide, but you are trying to look at the the 4th column.

 

[Mallesh23]

Hi Fluff,

Thanks for highlighting the bug, in ary_english there are two items.

Getting error message at below.

 'Print Array Output in Range
    Range("H2:H10").Value = ary_english 'Print english Marks  {No Output}

    'Subscript out of range
    Range("h2").Resize(UBound(ary_english)).Value = ary_english(0) 'Print Maths Marks
     Range("i2").Resize(UBound(ary_english)).Value = ary_english(1) 'Print Maths Marks

how to extract items from Ary_english into ranges.

Thanks
mg

 

[Fluff]

Why are you putting bot the sets of marks into each array?
Surely you should put the English marks into the English array & the same for maths

 

[Mallesh23]

Hi Fluff,

You are right , Array_English Contains maths and English subjects Score,

But afterwords I am not getting idea, how to extract in Output Array.


Thanks
mg

 

[Fluff]

You are right , Array_English Contains maths and English subjects Score,

But why?
And if you want them in one array, why are you putting exactly the same values into the maths array?

 

[Mallesh23]

Hi Fluff,

Below code is working giving me result as expected,
But code is very lenghty , is there any way we can shorten the Code. Thanks.

Sub Dict_array_Combination()

    Dim dict_English As New Scripting.dictionary
    Dim dict_Maths As New Scripting.dictionary
   
    Dim arr As Variant
    Dim i As Long
    Dim ary As Variant
  
    arr = Range("A2:D13").Value
  
       Dim ary_english As Variant
        Dim ary_Maths As Variant
  
        ary_english = Range("G2:G10").Value
        ary_Maths = Range("G2:G10").Value
  
  
    'Store English Score and print it
    With dict_English
        For i = LBound(arr, 1) To UBound(arr, 1)
            If Not .Exists(arr(i, 1)) Then
                .Add (arr(i, 1)), arr(i, 2)  'English score
            End If
        Next i
  
            '-------Store English Marks-------
        For i = LBound(ary_english, 1) To UBound(ary_english, 1)
             ary_english(i, 1) = .Item(ary_english(i, 1))
       Next i
   
    End With
   
      Range("H2:H10").Value = ary_english  ' One go Print English Score
     
     
   
            'Store Maths Score and print it
     With dict_Maths
        For i = LBound(arr, 1) To UBound(arr, 1)
            If Not .Exists(arr(i, 1)) Then
                .Add (arr(i, 1)), arr(i, 4)   ' Maths Score
            End If
        Next i
  
            '-------Store English Marks-------
        For i = LBound(ary_Maths, 1) To UBound(ary_Maths, 1)
             ary_Maths(i, 1) = .Item(ary_Maths(i, 1))
       Next i
   
    End With
   
    Range("I2:I10").Value = ary_Maths  'One go Print Maths Score
   

End Sub

 

[Fluff]

Please edit your post to include tags, you should know that by now.