VBA: Searching for matches in array excel not responding

[knacksc2]

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?

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

 

[knacksc2]

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

 

[knacksc2]

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)

 

[hotabae]

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"

 

[knacksc2]

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.

 

[knacksc2]

you were right, stepping through did show me where it is failing with type mismatch error, this line:

        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?

 

[knacksc2]

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:

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

 

[hotabae]

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:

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:

[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.

 

[knacksc2]

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

 

[knacksc2]

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:

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...