The macro takes too long to run

[TamuraGui]

I have this code, it gets the demand of a particular part no, search for a supply in another table and returns the order, date, quantity, supplier and coordinator.
I tested this on a smaller sheet and it works well, but on the sheet that I need this to run I have 30k plus lines on each table, so it takes a really long time to run,
Do you guys have a clue on how to solve this problem?
The part no´s on demand and supply are not unique, so I search for the first supply of that part no and subtract the demand from the supply amount.

Sub Plan()

    Dim rows_supply As Long
    Dim array_pnsupply() As String, array_qtysupply() As Double, array_ordersupply() As String, array_datesupply() As Date
    Dim srow As Long, drow As Long, pos As Long, dcol As Long
    Dim demand As Double, supply As Double
    
    rows_supply = WorksheetFunction.CountIf(Sheets("supply").Range("a:a"), "<>" & "") - 1
    
    ReDim array_pnsupply(rows_supply - 1)
    ReDim array_qtysupply(rows_supply - 1)
    ReDim array_ordersupply(rows_supply - 1)
    ReDim array_datesupply(rows_supply - 1)
    ReDim array_suppliersupply(rows_supply - 1)
    ReDim array_coordinatorsupply(rows_supply - 1)
    
    srow = 2
    
    Do While Sheets("Supply").Cells(srow, 1) <> ""
        array_pnsupply(srow - 2) = Sheets("Supply").Cells(srow, 10)
        srow = srow + 1
    Loop
    
    srow = 2
    
    Do While Sheets("Supply").Cells(srow, 1) <> ""
        array_qtysupply(srow - 2) = Sheets("Supply").Cells(srow, 12)
        srow = srow + 1
    Loop
    
    srow = 2
    
    Do While Sheets("Supply").Cells(srow, 1) <> ""
        array_ordersupply(srow - 2) = Sheets("Supply").Cells(srow, 1)
        srow = srow + 1
    Loop
    
    srow = 2
    
    Do While Sheets("Supply").Cells(srow, 1) <> ""
        array_datesupply(srow - 2) = Sheets("Supply").Cells(srow, 26)
        srow = srow + 1
    Loop
    
    srow = 2
    
    Do While Sheets("Supply").Cells(srow, 1) <> ""
        array_suppliersupply(srow - 2) = Sheets("Supply").Cells(srow, 5)
        srow = srow + 1
    Loop
    
    srow = 2
    
    Do While Sheets("Supply").Cells(srow, 1) <> ""
        array_coordinatorsupply(srow - 2) = Sheets("Supply").Cells(srow, 7)
        srow = srow + 1
    Loop
    
    drow = 2
    dcol = 13
    
    Do While Sheets("Demand").Cells(drow, 7) <> ""
        demand = Sheets("Demand").Cells(drow, 9).Value
        supply = 0
        pos = 0
        Do While (pos <= rows_supply - 1) And (demand > 0)
            If (Sheets("Demand").Cells(drow, 7) = array_pnsupply(pos)) And (array_qtysupply(pos) > 0) Then
                supply = array_qtysupply(pos)
                demand = demand - supply
                If demand >= 0 Then
                    Sheets("Demand").Cells(drow, dcol) = array_ordersupply(pos)
                    Sheets("Demand").Cells(drow, dcol + 1) = array_qtysupply(pos)
                    Sheets("Demand").Cells(drow, dcol + 2) = array_suppliersupply(pos)
                    Sheets("Demand").Cells(drow, dcol + 3) = array_coordinatorsupply(pos)
                    Sheets("Demand").Cells(drow, dcol + 4) = array_datesupply(pos)
                    array_qtysupply(pos) = 0
                Else
                    Sheets("Demand").Cells(drow, dcol) = array_ordersupply(pos)
                    Sheets("Demand").Cells(drow, dcol + 1) = array_qtysupply(pos) + demand
                    Sheets("Demand").Cells(drow, dcol + 2) = array_suppliersupply(pos)
                    Sheets("Demand").Cells(drow, dcol + 3) = array_coordinatorsupply(pos)
                    Sheets("Demand").Cells(drow, dcol + 4) = array_datesupply(pos)
                    array_qtysupply(pos) = -demand
                End If
                dcol = dcol + 5
            End If
            pos = pos + 1
        Loop
        drow = drow + 1
        dcol = 13
    Loop
    
    MsgBox "Finished planning, you will be redirected to the analysis!"

End Sub

 

[johnnyL]

Without any data to play with from the OP, the following is all I can suggest to test:

Sub Plan()
'
    Dim StartTime                   As Double
    StartTime = Timer                                                                                               ' Start the stop watch
''
    Dim demand                      As Double, supply               As Double
    Dim ArrayRow                    As Long, rows_Demand            As Long, rows_supply                As Long
    Dim dcol                        As Long, drow                   As Long, srow                       As Long
    Dim pos                         As Long
    Dim DemandColumns               As String, SupplyColumns        As String
    Dim array_coordinatorsupply     As Variant, array_datesupply    As Variant, array_ordersupply       As Variant
    Dim array_pnsupply              As Variant, array_qtysupply     As Variant, array_suppliersupply    As Variant
    Dim DemandArray                 As Variant, SupplyArray         As Variant, TempArray               As Variant
'
    srow = 2
'
' Save data from Sheets("Supply") into 2D 1 Based SupplyArray
    SupplyColumns = "1,5,7,10,12,26"
    rows_supply = Sheets("Supply").Range("A" & srow).End(xlDown).Row
      SupplyArray = Application.Index(Cells, Evaluate("ROW(srow:" & rows_supply & ")"), Split(SupplyColumns, ","))
'
' Establish the size of various 1D 1 Based arrays
    ReDim array_coordinatorsupply(1 To UBound(SupplyArray, 1))
           ReDim array_datesupply(1 To UBound(SupplyArray, 1))
          ReDim array_ordersupply(1 To UBound(SupplyArray, 1))
             ReDim array_pnsupply(1 To UBound(SupplyArray, 1))
            ReDim array_qtysupply(1 To UBound(SupplyArray, 1))
       ReDim array_suppliersupply(1 To UBound(SupplyArray, 1))
'
' Load 2D 1 based SupplyArray data to 1D 1 Based various arrays
    For ArrayRow = 1 To UBound(SupplyArray, 1)
              array_ordersupply(ArrayRow) = SupplyArray(ArrayRow, 1)
           array_suppliersupply(ArrayRow) = SupplyArray(ArrayRow, 2)
        array_coordinatorsupply(ArrayRow) = SupplyArray(ArrayRow, 3)
                 array_pnsupply(ArrayRow) = SupplyArray(ArrayRow, 4)
                array_qtysupply(ArrayRow) = SupplyArray(ArrayRow, 5)
               array_datesupply(ArrayRow) = SupplyArray(ArrayRow, 6)
    Next
'
'---------------------------------------------------------------------------------------------------------
'
    drow = 2
    dcol = 13
'
' Save data from Sheets("Demand") into 2D 1 Based DemandArray
    DemandColumns = "7,9"
      rows_Demand = Sheets("Demand").Range("G" & drow).End(xlDown).Row
      DemandArray = Application.Index(Cells, Evaluate("ROW(1:" & rows_Demand & ")"), Split(DemandColumns, ","))
'
' Write data to Sheets("Demand")
    For ArrayRow = drow To UBound(DemandArray, 1)
        demand = DemandArray(ArrayRow, 2)
        supply = 0
        pos = 1                             ' was 0
'
        Do While pos <= rows_supply - srow + 1 And demand > 0
            If DemandArray(ArrayRow, 1) = array_pnsupply(pos) And array_qtysupply(pos) > 0 Then
                supply = array_qtysupply(pos)
                demand = demand - supply
'
                If demand >= 0 Then
                    TempArray(ArrayRow, dcol + 1) = array_qtysupply(pos)
                    array_qtysupply(pos) = 0
                Else
                    TempArray(ArrayRow, dcol + 1) = array_qtysupply(pos) + demand
                    array_qtysupply(pos) = -demand
                End If
'
                    TempArray(ArrayRow, dcol) = array_ordersupply(pos)
                TempArray(ArrayRow, dcol + 2) = array_suppliersupply(pos)
                TempArray(ArrayRow, dcol + 3) = array_coordinatorsupply(pos)
                TempArray(ArrayRow, dcol + 4) = array_datesupply(pos)
                Sheets("Demand").Range(dcol & ArrayRow & ":" & dcol + 4 & ArrayRow) = TempArray
'
                dcol = dcol + 5
            End If
'
            pos = pos + 1
        Loop
'
        dcol = 13
    Next
'
    Debug.Print "Time to complete = " & Timer - StartTime & " seconds."                                             ' Display the completion time in the 'Immediate' window ... CTRL+G in the VBE window

    MsgBox "Finished planning in " & Timer - StartTime & " seconds, you will be redirected to the analysis!"        ' Display Final result to user
End Sub