VBA: Searching for matches in array excel not responding

knacksc2

Board Regular
Joined
Jan 23, 2014
Messages
63
I am still learning how to use arrays well, but this appears to be working until it starts the br loop. the computer fan starts running high and when i click on excel it says not responding. what am i doing wrong?

Code:
Public Sub ReadToFromArray()

ActiveWorkbook.Worksheets("Data").Select
Dim a As Long
a = Application.WorksheetFunction.CountA(ActiveWorkbook.Worksheets("Data").Range(Cells(2, 1), Cells(1048576, 1)))


PRnum = Array(1, 5, 10, 11, 13, 18, 20, 21, 22, 23, 25, 28, 29, 33, 35)
PRtext = Array("1", "5", "10", "11", "13", "18", "20", "21", "22", "23", "25", "28", "29", "33", "35")


ActiveWorkbook.Worksheets("Arrays").Select
' Declare dynamic array for Pri to Br
Dim Network As Variant
Network = ActiveWorkbook.Worksheets("Arrays").Range(Cells(4, 2), Cells(36, 16)).Value


'delete the data we will not be using "B4:P36"
'ActiveWorkbook.Worksheets("Data").Columns("AG:AY").EntireColumn.Delete
'ActiveWorkbook.Worksheets("Data").Columns("O:AE").EntireColumn.Delete
'ActiveWorkbook.Worksheets("Data").Columns("K:L").EntireColumn.Delete
'ActiveWorkbook.Worksheets("Data").Columns("H:I").EntireColumn.Delete
'ActiveWorkbook.Worksheets("Data").Columns("C:F").EntireColumn.Delete


ActiveWorkbook.Worksheets("Data").Select
' Declare dynamic array for entire data set
Dim Dataset As Variant
Dataset = ActiveWorkbook.Worksheets("Data").Range(Cells(2, 1), Cells(a + 1, 7)).Value


For p = 0 To UBound(PRnum)


ActiveWorkbook.Worksheets("BR" & PRnum(p)).Select


'clean and populate primary data
ActiveWorkbook.Worksheets("BR" & PRnum(p)).Rows("5:1048576").EntireRow.Delete
Dim x As Long
x = 0
For li = 1 To a
If Dataset(li, 1) = PRnum(p) And Dataset(li, 3) = PRnum(p) And Dataset(li, 7) > 0 Then
ActiveWorkbook.Worksheets("BR" & PRnum(p)).Cells(x + 5, 2).Value = Dataset(li, 2)
ActiveWorkbook.Worksheets("BR" & PRnum(p)).Cells(x + 5, 3).Value = Dataset(li, 4)
ActiveWorkbook.Worksheets("BR" & PRnum(p)).Cells(x + 5, 4).Value = Round(Dataset(li, 7), 0)
If ActiveWorkbook.Worksheets("BR" & PRnum(p)).Cells(x + 5, 4).Value <= ActiveWorkbook.Worksheets("BR" & PRnum(p)).Cells(x + 5, 3).Value Then
Else
ActiveWorkbook.Worksheets("BR" & PRnum(p)).Cells(x + 5, 5).Value = ActiveWorkbook.Worksheets("BR" & PRnum(p)).Cells(x + 5, 4).Value - ActiveWorkbook.Worksheets("BR" & PRnum(p)).Cells(x + 5, 3).Value
End If
x = (x + 1)
Else
End If
Next li


Dim y As Long
y = Application.WorksheetFunction.CountA(ActiveWorkbook.Worksheets("BR" & PRnum(p)).Range(Cells(5, 2), Cells(1048576, 2)))


Dim Lines As Variant
Lines = ActiveWorkbook.Worksheets("BR" & PRnum(p)).Range(Cells(5, 2), Cells(y + 4, 2)).Value


For br = 1 To 33


    For pli = 1 To y
    
        For li2 = 1 To a
        
        If Dataset(li2, 2) = Lines(pli, 1) And Dataset(li2, 1) = Network(p + 1, br) And Dataset(li2, 7) > 0 Then
        
        ActiveWorkbook.Worksheets("BR" & PRnum(p)).Cells(pli + 4, (br * 2) + 12).Value = Dataset(li2, 4)
        ActiveWorkbook.Worksheets("BR" & PRnum(p)).Cells(pli + 4, (br * 2) + 13).Value = Round(Dataset(li2, 7), 0)


        GoTo FoundIt
        Else
        
        End If


        Next li2
FoundIt:
    Next pli


Next br
Next p
End Sub
 
Last edited:

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
My internet policy at work won't let me upload a file, but i can email the file if anyone wants it. just let me know
 
Upvote 0
to put the problem in more logical terms, the 'br' loop is supposed to loop through each of the receiving branches, loop through the 'Dataset' array looking for where the part number matches the 'Lines' array, the branch number matches and the usage on that item is greater than 0. if those things are true then i populate the qty available and the 6 mo usage, otherwise leave it blank (do nothing)
 
Upvote 0
Well, I'm a fairly basic user, but I know there could definitely be issues using nested 'for' loops with 4 levels.

While I highly doubt you are using over a million rows in your table (hardcoded bottom row), it could start causing problems fairly quickly dependent on the number of rows.
My guess at the most simple reason is that the program is just taking a really long time because there are a lot of iterations.

So I guess a good place to start is... How many rows does your table have? (or more specifically, what are your 'a' and 'y' values)

Another recommendation I could make is to use the breakpoint tool in VBA (place it next to 'For p = 0 To UBound(PRnum) ') and then step through (F8) to see if you can clear all the way to "foundIt"
 
Upvote 0
104857 is not hard coded as the bottom of the table, just for the count function. Perhaps i am wrong. that was my way of making the iteration exactly as long as it needed to be. let me know if that sounds right.

as for the breakpoint tool, i have never used it before, i will see what i can figure with it right away and get back to you. thanks for the direction so far.
 
Upvote 0
you were right, stepping through did show me where it is failing with type mismatch error, this line:

Code:
        If Dataset(li2, 2) = Lines(pli, 1) And Dataset(li2, 1) = Network(br, p + 1) And Dataset(li2, 7) > 0 Then

any idea what could be wrong?
 
Upvote 0
i divided the if statement out to see if i could gain better insight, and it failed on the second iteration of the 'li2 loop at the first if line shown below:
Code:
For br = 1 To 33    For pli = 1 To 10 'y
    
        For li2 = 1 To 10 'a
        
        'If Lines(pli, 1) = Dataset(li2, 2) And Dataset(li2, 1) = Network(br, p + 1) And Dataset(li2, 7) > 0 Then
        If Lines(pli, 1) = Dataset(li2, 2) Then
        If Dataset(li2, 1) = Network(br, p + 1) Then
        If Dataset(li2, 7) > 0 Then
 
Upvote 0
Yeah,

My guess is it has to do with the fact that all your arrays are declared as 'Variant' (common first step for dynamic arrays).



My first step with such things would be Inserting this above the 'error' line:

Code:
MsgBox("DatasetType = " & Typename(Dataset(li2,2)) & vbNewLine & "LinesType = " & Typename(Lines(pli,1)) & vbNewLine & "NetworkType = " & Typename(Network(br,p+1)))

That^ will show what variable type it is trying to 'cast' them as. I would imagine they are not all the same and it's causing a mismatch.

Most people recommend avoiding 'variant' variables whenever possible, for reasons like this.



If you know what data type you will be using in these arrays, I'd recommend declaring your arrays beforehand -> Dim dataset() As String (Long, float, Boolean... etc)

Or... the sloppy way to do it (which I do all the time) is to 'cast' or convert the datatype to the same thing after-the-fact:

Code:
[LEFT][COLOR=#333333][FONT=monospace] If Clng(Dataset(li2, 2)) = Clng(Lines(pli, 1)) And Clng(Dataset(li2, 1)) = Clng(Network(br, p + 1)) And Clng(Dataset(li2, 7)) > 0 Then [/FONT][/COLOR][/LEFT]

That^ is not really a typical course of action, but it will treat all your arguments as the 'Long' data type (preventing mismatch). I use this for debugging/quickfixes.
 
Upvote 0
Wow, o.k. will try this right away. will get right back to you. thanks for the direction and education on data types in arrays
 
Upvote 0
so the msgbox line gives me the same error, and i still get a type mismatch error even when using the CLng() here is the code:

Code:
For br = 1 To 33    
For pli = 1 To y
        For li2 = 1 To a
        MsgBox ("DatasetType = " & TypeName(Dataset(li2, 2)) & vbNewLine & "LinesType = " & TypeName(Lines(pli, 1)) & vbNewLine & "NetworkType = " & TypeName(Network(br, p + 1)))
        'If CLng(Lines(pli, 1)) = CLng(Dataset(li2, 2)) And CLng(Dataset(li2, 1)) = CLng(Network(br, p + 1)) And CLng(Dataset(li2, 7)) > 0 Then
        If CLng(Lines(pli, 1)) = CLng(Dataset(li2, 2)) Then
        If Dataset(li2, 1) = Network(br, p + 1) Then
        If Dataset(li2, 7) > 0 Then

I must be doing something wrong...
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,202
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