Compare two complex 2-D Arrays. Need faster Code !

Ombir

Active Member
Joined
Oct 1, 2015
Messages
433
Good evening Geeks,

I have a Sheet shown below which contains marks of students. I want to compare each Subject and Subject marks of student with a a reference table which contains Subject Name, Min, Max limit of marks and a flag to determine whether a subject is practical or not.

If column Isprac is "Y" then I need to compare sub,th,pr column of each subject with reference table and if subject is found and marks are within max and min limit then total to be calculated in tot column for each subject and student.

If column Isprac is "N" then then I need to compare sub,th column of each subject with reference table and if subject is found and marks are within max and min limit then total to be calculated in tot column for each subject and student.

I have written below code which is working fine but it is very slow as I have large number of records.

Code:
Sub compare()
Dim i As Long, j As Long, k As Long, lr As Long, lc As Long, sb As String
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ar(7, 5) As Variant

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
lr = Cells(Rows.Count, 1).End(xlUp).Row
lc = Cells(1, Columns.Count).End(xlToLeft).Column

For i = 0 To 7
    For j = 0 To 5
        ar(i, j) = ws2.Cells(i + 2, j + 1)
    Next
Next
ws1.Activate
For i = 2 To lr
    For j = 2 To lc Step 4
        sb = Cells(i, j).Value
        th = Cells(i, j + 1).Value
        pr = Cells(i, j + 2).Value
            For k = 0 To 7
                If sb = ar(k, 0) Then
                    If ar(k, 5) = "N" Then
                        If Val(ar(k, 2)) <= Val(th) And Val(th) <= Val(ar(k, 1)) Then
                            tot = Val(th)
                            Cells(i, j + 3).Value = tot
                            Exit For
                        Else
                            Cells(i, j + 3).Value = " "
                        End If
                    Else
                        If (Val(th) >= Val(ar(k, 2)) And Val(th) <= Val(ar(k, 1))) And (Val(pr) >= Val(ar(k, 4)) And Val(pr) <= Val(ar(k, 3))) Then
                            tot = Val(th) + Val(pr)
                            Cells(i, j + 3).Value = tot
                            Exit For
                        Else
                            Cells(i, j + 3).Value = " "
                        End If
                    End If
                End If
            Next
    Next
Next
End Sub

Data Sheet:


ABCDEFGHIJKLMNOPQ
1RollSUB1TH1PR1TOT1SUB2TH2PR2TOT2SUB3TH3PR3TOT3SUB4TH4PR4TOT4
25001BIO196HIC38PHY3312CHE3415
35002PHY2310HIC42CHE205MAT55
45003ACC3130HIC12MAT14HOS3735
55004BUS44HIC85PHY1721HOS5641
65005MAT74HIC77CHE6517PHY917

<tbody>
</tbody>
Sheet3



Reference Table:

ABCDEF
1SUBTHMAXTHMINPRMAXPRMINISPRAC
2ENC8027N
3HIC8027N
4PHY6020207Y
5CHE6020207Y
6MAT8027N
7HOS60204014Y
8ACC8027207Y
9BUS8027N

<tbody>
</tbody>
Sheet2



Output Needed:

ABCDEFGHIJKLMNOPQ
1RollSUB1TH1PR1TOT1SUB2TH2PR2TOT2SUB3TH3PR3TOT3SUB4TH4PR4TOT4
25001BIO196HIC3838PHY331245CHE341549
35002PHY231033HIC4242CHE205 MAT5555
45003ACC3130 HIC12 MAT14 HOS373572
55004BUS4444HIC85 PHY1721 HOS5641
65005MAT7474HIC7777CHE6517 PHY917

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1



I am new to VBA. I would be grateful if anybody can assist me and provide some faster code with array or similar.

Thank you !
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Rothstein, Hiker, Heyden, Peter! Where are you guys? I hope this question hasn't been asked before. Could you lend me a hand here ?
 
Upvote 0
To be precise, I want to replace all my If conditions with 2-3 functions(or as required) so that I could call the function whenever needed. Can anybody help me here please ?
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top