Speed up copy and paste

kgkev · Oct 21, 2022

I have a macro which seems to be dragging its heels on a copy & paste function, it's only milliseconds but the operation is repeated around 4000 times so it takes about 30 minutes to complete.

In reality, I will normally be copying 0-20 lines of data.

VBA Code:

    With Sheets("PO")
        .Range("A1").Value = "'" & Sheets("Future Stock").Range("A1").Value
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False
        .Range("A5:E1000").Copy Destination:=Sheets("Future Stock").Range("A56000").End(xlUp).Offset(1)
    End With

A 2nd, 3rd & 4th Query is then stacked onto the bottom in the same format.

VBA Code:

    With Sheets("WO")
        .Range("A1").Value = "'" & Sheets("Future Stock").Range("A1").Value
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False
        .Range("A5:E1000").Copy Destination:=Sheets("Future Stock").Range("A56000").End(xlUp).Offset(1)
    End With

VBA Code:

    With Sheets("SO")
        .Range("A1").Value = "'" & Sheets("Future Stock").Range("A1").Value
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False
        .Range("A5:E1000").Copy Destination:=Sheets("Future Stock").Range("A56000").End(xlUp).Offset(1)
    End With

VBA Code:

    With Sheets("WO MAKE")
        .Range("A1").Value = "'" & Sheets("Future Stock").Range("A1").Value
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False
         .Range("A5:E1000").Copy Destination:=Sheets("Future Stock").Range("A56000").End(xlUp).Offset(1)
    End With

this sheet is then cleared with a new product code queried, with 4000 products to work through.

i know I could use
.Range("A5:E1000").values = sheets("Future Stock").Range("Axxx:Exxxx)
but I do not know how to set this to the right size and location to site at the bottom of any potential existing date.

On the future stock sheet I need the data to site under A6 which after clear down is not blank.

Any help would be appreciated....hopefully I haven't over complicated the question.

johnnyL · Oct 21, 2022

I see you are addressing the sheets quite a bit, that will slow your results down.

I also think the code you haven't posted may also be a culprit in the slow times you are experiencing.

That being said, try replacing the code you already posted with the following code:

VBA Code:

    Dim ArrayColumn                 As Long, ArrayRow                   As Long
    Dim LastUsedArrayRow            As Long
    Dim LastUsed_PO_ArrayRow        As Long, LastUsed_SO_ArrayRow       As Long
    Dim LastUsed_WO_ArrayRow        As Long, LastUsed_WO_MAKE_ArrayRow  As Long
    Dim OutputArrayRows             As Long
    Dim SamePastedValue             As String
    Dim OutputArray()               As Variant
    Dim PO_Array                    As Variant, SO_Array                As Variant
    Dim WO_Array                    As Variant, WO_MAKE_Array           As Variant
'
    SamePastedValue = "'" & Sheets("Future Stock").Range("A1").Value                                                    ' Save "'" & Sheets("Future Stock").Range("A1").Value into SamePastedValue
'
    With Sheets("PO")
        .Range("A1").Value = SamePastedValue                                                                            '   Write SamePastedValue to Sheets("PO").Range("A1")
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False                                                          '
        PO_Array = .Range("A5:E1000")                                                                                   '   Save Sheets("PO").Range("A5:E1000") into PO_Array
    End With
'
    For ArrayRow = UBound(PO_Array, 1) To 1 Step -1                                                                     ' Loop through PO_Array rows backwards
        For ArrayColumn = 1 To UBound(PO_Array, 2)                                                                      '   Loop through columns of PO_Array
            If PO_Array(ArrayRow, ArrayColumn) <> vbNullString Then                                                     '       If a value is found then ...
                LastUsedArrayRow = ArrayRow                                                                             '           Save the ArrayRow to LastUsedArrayRow
                Exit For                                                                                                '           Exit the For Loop
            End If
        Next                                                                                                            '   Loop back
'
        If LastUsedArrayRow > 0 Then Exit For                                                                           '   If we have found a value in the array then Exit the For Loop
    Next                                                                                                                ' Loop back
'
    LastUsed_PO_ArrayRow = LastUsedArrayRow                                                                             ' Save the LastUsedArrayRow into LastUsed_PO_ArrayRow
'
'-----------------------------------------------------------------------------------------------------------------------
'
    LastUsedArrayRow = 0                                                                                                ' Reset LastUsedArrayRow back to zero
'
    With Sheets("WO")
        .Range("A1").Value = SamePastedValue                                                                            '   Write SamePastedValue to Sheets("WO").Range("A1")
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False                                                          '
        WO_Array = .Range("A5:E1000")                                                                                   '   Save Sheets("WO").Range("A5:E1000") into WO_Array
    End With
'
    For ArrayRow = UBound(WO_Array, 1) To 1 Step -1                                                                     ' Loop through WO_Array rows backwards
        For ArrayColumn = 1 To UBound(WO_Array, 2)                                                                      '   Loop through columns of WO_Array
            If WO_Array(ArrayRow, ArrayColumn) <> vbNullString Then                                                     '       If a value is found then ...
                LastUsedArrayRow = ArrayRow                                                                             '           Save the ArrayRow to LastUsedArrayRow
                Exit For                                                                                                '           Exit the For Loop
            End If
        Next                                                                                                            '   Loop back
'
        If LastUsedArrayRow > 0 Then Exit For                                                                           '   If LastUsedArrayRow > 0 Then Exit For Loop
    Next                                                                                                                ' Loop back
'
    LastUsed_WO_ArrayRow = LastUsedArrayRow                                                                             ' Save the LastUsedArrayRow into LastUsed_WO_ArrayRow
'
'-----------------------------------------------------------------------------------------------------------------------
'
    LastUsedArrayRow = 0                                                                                                ' Reset LastUsedArrayRow back to zero
'
    With Sheets("SO")
        .Range("A1").Value = SamePastedValue                                                                            '   Write SamePastedValue to Sheets("WO").Range("A1")
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False                                                          '
        SO_Array = .Range("A5:E1000")                                                                                   '   Save Sheets("SO").Range("A5:E1000") into SO_Array
    End With
'
    For ArrayRow = UBound(SO_Array, 1) To 1 Step -1                                                                     ' Loop through SO_Array rows backwards
        For ArrayColumn = 1 To UBound(SO_Array, 2)                                                                      '   Loop through columns of SO_Array
            If SO_Array(ArrayRow, ArrayColumn) <> vbNullString Then                                                     '       If a value is found then ...
                LastUsedArrayRow = ArrayRow                                                                             '           Save the ArrayRow to LastUsedArrayRow
                Exit For                                                                                                '           Exit the For Loop
            End If
        Next                                                                                                            '   Loop back
'
        If LastUsedArrayRow > 0 Then Exit For                                                                           '   If LastUsedArrayRow > 0 Then Exit For Loop
    Next                                                                                                                ' Loop back
'
    LastUsed_SO_ArrayRow = LastUsedArrayRow                                                                             ' Save the LastUsedArrayRow into LastUsed_SO_ArrayRow
'
'-----------------------------------------------------------------------------------------------------------------------
'
    LastUsedArrayRow = 0                                                                                                ' Reset LastUsedArrayRow back to zero
'
    With Sheets("WO MAKE")
        .Range("A1").Value = SamePastedValue                                                                            '   Write SamePastedValue to Sheets("WO MAKE").Range("A1")
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False                                                          '
        WO_MAKE_Array = .Range("A5:E1000")                                                                              '   Save Sheets("WO MAKE").Range("A5:E1000") into WO_MAKE_Array
    End With
'
' Find last used row in WO_MAKE_Array
    For ArrayRow = UBound(WO_MAKE_Array, 1) To 1 Step -1                                                                ' Loop through WO_MAKE_Array rows backwards
        For ArrayColumn = 1 To UBound(WO_MAKE_Array, 2)                                                                 '   Loop through columns of WO_MAKE_Array
            If WO_MAKE_Array(ArrayRow, ArrayColumn) <> vbNullString Then                                                '       If a value is found then ...
                LastUsedArrayRow = ArrayRow                                                                             '           Save the ArrayRow to LastUsedArrayRow
                Exit For                                                                                                '           Exit the For Loop
            End If
        Next                                                                                                            '   Loop back
'
        If LastUsedArrayRow > 0 Then Exit For                                                                           '   If LastUsedArrayRow > 0 Then Exit For Loop
    Next                                                                                                                ' Loop back
'
    LastUsed_WO_MAKE_ArrayRow = LastUsedArrayRow                                                                        ' Save the LastUsedArrayRow into LastUsed_WO_MAKE_ArrayRow
'
'-----------------------------------------------------------------------------------------------------------------------
'
    OutputArrayRows = LastUsed_PO_ArrayRow + LastUsed_WO_ArrayRow + LastUsed_SO_ArrayRow + LastUsed_WO_MAKE_ArrayRow    ' Calculate # of rows for OutputArray
'
    ReDim OutputArray(1 To OutputArrayRows, 1 To UBound(PO_Array, 2))                                                   ' Establish # of rows and columns for the OutputArray
'
    For ArrayRow = 1 To LastUsed_PO_ArrayRow                                                                            ' Loop through the rows of PO_Array
        For ArrayColumn = 1 To UBound(PO_Array, 2)                                                                      '   Loop through the columns of PO_Array
            OutputArray(ArrayRow, ArrayColumn) = PO_Array(ArrayRow, ArrayColumn)                                        '       Write value from PO_Array into OutputArray
        Next                                                                                                            '   Loop back
    Next                                                                                                                ' Loop back
'
    OutputArrayRow = ArrayRow - 1                                                                                       ' Set OutputArrayRow = ArrayRow - 1
'
'-----------------------------------------------------------------------------------------------------------------------
'
    For ArrayRow = 1 To LastUsed_WO_ArrayRow                                                                            ' Loop through the rows of WO_Array
        OutputArrayRow = OutputArrayRow + 1                                                                             '   Increment OutputArrayRow
'
        For ArrayColumn = 1 To UBound(WO_Array, 2)                                                                      '   Loop through the columns of WO_Array
            OutputArray(OutputArrayRow, ArrayColumn) = WO_Array(ArrayRow, ArrayColumn)                                  '       Write value from WO_Array into OutputArray
        Next                                                                                                            '   Loop back
    Next                                                                                                                ' Loop back
'
'-----------------------------------------------------------------------------------------------------------------------
'
    For ArrayRow = 1 To LastUsed_SO_ArrayRow                                                                            ' Loop through the rows of SO_Array
        OutputArrayRow = OutputArrayRow + 1                                                                             '   Increment OutputArrayRow
'
        For ArrayColumn = 1 To UBound(SO_Array, 2)                                                                      '   Loop through the columns of SO_Array
            OutputArray(OutputArrayRow, ArrayColumn) = SO_Array(ArrayRow, ArrayColumn)                                  '       Write value from SO_Array into OutputArray
        Next                                                                                                            '   Loop back
    Next                                                                                                                ' Loop back
'
'-----------------------------------------------------------------------------------------------------------------------
'
    For ArrayRow = 1 To LastUsed_WO_MAKE_ArrayRow                                                                       ' Loop through the rows of WO_MAKE_Array
        OutputArrayRow = OutputArrayRow + 1                                                                             '   Increment OutputArrayRow
'
        For ArrayColumn = 1 To UBound(WO_MAKE_Array, 2)                                                                 '   Loop through the columns of WO_MAKE_Array
            OutputArray(OutputArrayRow, ArrayColumn) = WO_MAKE_Array(ArrayRow, ArrayColumn)                             '       Write value from WO_MAKE_Array into OutputArray
        Next                                                                                                            '   Loop back
    Next                                                                                                                ' Loop back
'
'-----------------------------------------------------------------------------------------------------------------------
'
    Sheets("Future Stock").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(OutputArray, 1), _
            UBound(OutputArray, 2)) = OutputArray                                                                       ' Write the OutputArray results to Sheets("Future Stock")

That should reduce the time for the code you have submitted thus far.

kgkev · Oct 24, 2022

Thanks, you have outdone yourself with the effort in your reply. It worked perfectly the first time and certainly sped the process up! However, as you suggest the code is still very slow to run....

It is very strange, I wrote the code in 2019 and at the time it took about 10 minutes to complete the number of records would have been no different.
Now I am lucky if it completes in less than 1 hour.

here is the complete code in case you can see anything obvious I can improve.

VBA Code:

Sub Where_Used()


'17th April 2019
'Optional update - Takes a few minutes to run
'Find where the requirement is for each of the on-order components
'Then check to see if future stock is ever below zero
'Used for "Filter By Contract", "Filter by Spares" & "Filter Late PO"

    Application.ScreenUpdating = False
    Dim prod As Variant
    Dim CS As Worksheet
    Set CS = Sheets("Data")
    On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("Where Used").Delete
        Application.DisplayAlerts = True
    On Error GoTo -1

    With ThisWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Where Used"
    End With

    Set FS = Sheets("Where Used")

    FS.Range("A1").Value = "warehouse"
    FS.Range("A2").Value = "'00"

    CS.Range("G1:H10000").AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=FS.Range("A1:A2"), _
        CopyToRange:=FS.Range("A12"), _
        Unique:=True
        
    FS.Rows("1:11").Delete
    FS.Cells.EntireColumn.AutoFit
    Range("A:A").Delete Shift:=xlToLeft
    
    Worksheets("Where Used").Sort.SortFields.Clear
    Worksheets("Where Used").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With Worksheets("Where Used").Sort
        .SetRange Range("A:A")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    

'creates a progress bar.
    item_count = Worksheets("Where Used").Range("A2", Worksheets("Where Used").Range("A5000").End(xlUp)).Count
    prog_unit = 216 / item_count
    Step_Count = 0
    With Progress_window
        .progbar.Width = 0
        .Show False
        .Repaint
    End With

    For Each Item In Worksheets("Where Used").Range("A2", Worksheets("Where Used").Range("A5000").End(xlUp))
        
        With Progress_window
            Step_Count = Step_Count + 1
            Curr_width = Curr_width + prog_unit
            .progbar.Width = Curr_width
            .Label1.Caption = Step_Count & " / " & item_count
            .Repaint
        End With
        
        Sheets("Future Stock").Range("A1").Value = "'" & Item.Value
        Sheets("stock").Range("A1").Value = "'" & Item.Value
            

   'Creates a predict future stock report
    
    Sheets("stock").Range("A2").ListObject.QueryTable.Refresh BackgroundQuery:=False
    Sheets("Future Stock").Range("F6").Value = Sheets("stock").Range("A3").Value
    Sheets("Future Stock").Range("A6").Value = "Physical Stock"
    
    Sheets("Future Stock").Range("A7:E56000").ClearContents
    
'UPDATED 24/10/22
'https://www.mrexcel.com/board/threads/speed-up-copy-and-paste.1219919/#post-5965592

    Dim ArrayColumn                 As Long, ArrayRow                   As Long
    Dim LastUsedArrayRow            As Long
    Dim LastUsed_PO_ArrayRow        As Long, LastUsed_SO_ArrayRow       As Long
    Dim LastUsed_WO_ArrayRow        As Long, LastUsed_WO_MAKE_ArrayRow  As Long
    Dim OutputArrayRows             As Long
    Dim SamePastedValue             As String
    Dim OutputArray()               As Variant
    Dim PO_Array                    As Variant, SO_Array                As Variant
    Dim WO_Array                    As Variant, WO_MAKE_Array           As Variant
'
    SamePastedValue = "'" & Sheets("Future Stock").Range("A1").Value                                                    ' Save "'" & Sheets("Future Stock").Range("A1").Value into SamePastedValue
'
    With Sheets("PO")
        .Range("A1").Value = SamePastedValue                                                                            '   Write SamePastedValue to Sheets("PO").Range("A1")
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False                                                          '
        PO_Array = .Range("A5:E1000")                                                                                   '   Save Sheets("PO").Range("A5:E1000") into PO_Array
    End With
'
    For ArrayRow = UBound(PO_Array, 1) To 1 Step -1                                                                     ' Loop through PO_Array rows backwards
        For ArrayColumn = 1 To UBound(PO_Array, 2)                                                                      '   Loop through columns of PO_Array
            If PO_Array(ArrayRow, ArrayColumn) <> vbNullString Then                                                     '       If a value is found then ...
                LastUsedArrayRow = ArrayRow                                                                             '           Save the ArrayRow to LastUsedArrayRow
                Exit For                                                                                                '           Exit the For Loop
            End If
        Next                                                                                                            '   Loop back
'
        If LastUsedArrayRow > 0 Then Exit For                                                                           '   If we have found a value in the array then Exit the For Loop
    Next                                                                                                                ' Loop back
'
    LastUsed_PO_ArrayRow = LastUsedArrayRow                                                                             ' Save the LastUsedArrayRow into LastUsed_PO_ArrayRow
'
'-----------------------------------------------------------------------------------------------------------------------
'
    LastUsedArrayRow = 0                                                                                                ' Reset LastUsedArrayRow back to zero
'
    With Sheets("WO")
        .Range("A1").Value = SamePastedValue                                                                            '   Write SamePastedValue to Sheets("WO").Range("A1")
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False                                                          '
        WO_Array = .Range("A5:E1000")                                                                                   '   Save Sheets("WO").Range("A5:E1000") into WO_Array
    End With
'
    For ArrayRow = UBound(WO_Array, 1) To 1 Step -1                                                                     ' Loop through WO_Array rows backwards
        For ArrayColumn = 1 To UBound(WO_Array, 2)                                                                      '   Loop through columns of WO_Array
            If WO_Array(ArrayRow, ArrayColumn) <> vbNullString Then                                                     '       If a value is found then ...
                LastUsedArrayRow = ArrayRow                                                                             '           Save the ArrayRow to LastUsedArrayRow
                Exit For                                                                                                '           Exit the For Loop
            End If
        Next                                                                                                            '   Loop back
'
        If LastUsedArrayRow > 0 Then Exit For                                                                           '   If LastUsedArrayRow > 0 Then Exit For Loop
    Next                                                                                                                ' Loop back
'
    LastUsed_WO_ArrayRow = LastUsedArrayRow                                                                             ' Save the LastUsedArrayRow into LastUsed_WO_ArrayRow
'
'-----------------------------------------------------------------------------------------------------------------------
'
    LastUsedArrayRow = 0                                                                                                ' Reset LastUsedArrayRow back to zero
'
    With Sheets("SO")
        .Range("A1").Value = SamePastedValue                                                                            '   Write SamePastedValue to Sheets("WO").Range("A1")
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False                                                          '
        SO_Array = .Range("A5:E1000")                                                                                   '   Save Sheets("SO").Range("A5:E1000") into SO_Array
    End With
'
    For ArrayRow = UBound(SO_Array, 1) To 1 Step -1                                                                     ' Loop through SO_Array rows backwards
        For ArrayColumn = 1 To UBound(SO_Array, 2)                                                                      '   Loop through columns of SO_Array
            If SO_Array(ArrayRow, ArrayColumn) <> vbNullString Then                                                     '       If a value is found then ...
                LastUsedArrayRow = ArrayRow                                                                             '           Save the ArrayRow to LastUsedArrayRow
                Exit For                                                                                                '           Exit the For Loop
            End If
        Next                                                                                                            '   Loop back
'
        If LastUsedArrayRow > 0 Then Exit For                                                                           '   If LastUsedArrayRow > 0 Then Exit For Loop
    Next                                                                                                                ' Loop back
'
    LastUsed_SO_ArrayRow = LastUsedArrayRow                                                                             ' Save the LastUsedArrayRow into LastUsed_SO_ArrayRow
'
'-----------------------------------------------------------------------------------------------------------------------
'
    LastUsedArrayRow = 0                                                                                                ' Reset LastUsedArrayRow back to zero
'
    With Sheets("WO MAKE")
        .Range("A1").Value = SamePastedValue                                                                            '   Write SamePastedValue to Sheets("WO MAKE").Range("A1")
        .Range("A4").QueryTable.Refresh BackgroundQuery:=False                                                          '
        WO_MAKE_Array = .Range("A5:E1000")                                                                              '   Save Sheets("WO MAKE").Range("A5:E1000") into WO_MAKE_Array
    End With
'
' Find last used row in WO_MAKE_Array
    For ArrayRow = UBound(WO_MAKE_Array, 1) To 1 Step -1                                                                ' Loop through WO_MAKE_Array rows backwards
        For ArrayColumn = 1 To UBound(WO_MAKE_Array, 2)                                                                 '   Loop through columns of WO_MAKE_Array
            If WO_MAKE_Array(ArrayRow, ArrayColumn) <> vbNullString Then                                                '       If a value is found then ...
                LastUsedArrayRow = ArrayRow                                                                             '           Save the ArrayRow to LastUsedArrayRow
                Exit For                                                                                                '           Exit the For Loop
            End If
        Next                                                                                                            '   Loop back
'
        If LastUsedArrayRow > 0 Then Exit For                                                                           '   If LastUsedArrayRow > 0 Then Exit For Loop
    Next                                                                                                                ' Loop back
'
    LastUsed_WO_MAKE_ArrayRow = LastUsedArrayRow                                                                        ' Save the LastUsedArrayRow into LastUsed_WO_MAKE_ArrayRow
'
'-----------------------------------------------------------------------------------------------------------------------
'
    OutputArrayRows = LastUsed_PO_ArrayRow + LastUsed_WO_ArrayRow + LastUsed_SO_ArrayRow + LastUsed_WO_MAKE_ArrayRow    ' Calculate # of rows for OutputArray
'
    ReDim OutputArray(1 To OutputArrayRows, 1 To UBound(PO_Array, 2))                                                   ' Establish # of rows and columns for the OutputArray
'
    For ArrayRow = 1 To LastUsed_PO_ArrayRow                                                                            ' Loop through the rows of PO_Array
        For ArrayColumn = 1 To UBound(PO_Array, 2)                                                                      '   Loop through the columns of PO_Array
            OutputArray(ArrayRow, ArrayColumn) = PO_Array(ArrayRow, ArrayColumn)                                        '       Write value from PO_Array into OutputArray
        Next                                                                                                            '   Loop back
    Next                                                                                                                ' Loop back
'
    OutputArrayRow = ArrayRow - 1                                                                                       ' Set OutputArrayRow = ArrayRow - 1
'
'-----------------------------------------------------------------------------------------------------------------------
'
    For ArrayRow = 1 To LastUsed_WO_ArrayRow                                                                            ' Loop through the rows of WO_Array
        OutputArrayRow = OutputArrayRow + 1                                                                             '   Increment OutputArrayRow
'
        For ArrayColumn = 1 To UBound(WO_Array, 2)                                                                      '   Loop through the columns of WO_Array
            OutputArray(OutputArrayRow, ArrayColumn) = WO_Array(ArrayRow, ArrayColumn)                                  '       Write value from WO_Array into OutputArray
        Next                                                                                                            '   Loop back
    Next                                                                                                                ' Loop back
'
'-----------------------------------------------------------------------------------------------------------------------
'
    For ArrayRow = 1 To LastUsed_SO_ArrayRow                                                                            ' Loop through the rows of SO_Array
        OutputArrayRow = OutputArrayRow + 1                                                                             '   Increment OutputArrayRow
'
        For ArrayColumn = 1 To UBound(SO_Array, 2)                                                                      '   Loop through the columns of SO_Array
            OutputArray(OutputArrayRow, ArrayColumn) = SO_Array(ArrayRow, ArrayColumn)                                  '       Write value from SO_Array into OutputArray
        Next                                                                                                            '   Loop back
    Next                                                                                                                ' Loop back
'
'-----------------------------------------------------------------------------------------------------------------------
'
    For ArrayRow = 1 To LastUsed_WO_MAKE_ArrayRow                                                                       ' Loop through the rows of WO_MAKE_Array
        OutputArrayRow = OutputArrayRow + 1                                                                             '   Increment OutputArrayRow
'
        For ArrayColumn = 1 To UBound(WO_MAKE_Array, 2)                                                                 '   Loop through the columns of WO_MAKE_Array
            OutputArray(OutputArrayRow, ArrayColumn) = WO_MAKE_Array(ArrayRow, ArrayColumn)                             '       Write value from WO_MAKE_Array into OutputArray
        Next                                                                                                            '   Loop back
    Next                                                                                                                ' Loop back
'
'-----------------------------------------------------------------------------------------------------------------------
'
    Sheets("Future Stock").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(OutputArray, 1), _
            UBound(OutputArray, 2)) = OutputArray                                                                       ' Write the OutputArray results to Sheets("Future Stock")
  
    'Builds a list of all the Sales Order & Works order requirments
    whereused = ""
    If WorksheetFunction.CountA(Sheets("Future Stock").Range("A2:A1000")) <> 0 Then
        For Each req In Sheets("Future Stock").Range("A7", Sheets("Future Stock").Range("A1000").End(xlUp))
            If req.Offset(, 4).Value = "SO" Then
                If whereused = "" Then
                    whereused = "SO~" & req.Value
                Else
                    whereused = whereused & "; " & req.Value
                End If
            End If
            
            If req.Offset(, 4).Value = "WO" Then
                If whereused = "" Then
                    whereused = "WO~" & req.Value
                Else
                    whereused = whereused & "; " & req.Value
                End If
            End If
        Next req
    End If
    
    'If parts do not have any requirement
    'Check if they are required as "Stock" items or if they are exceptions
    
    If whereused = "" Then
        Sheets("stock").Range("A1").Value = Item.Value
        Sheets("stock").Range("A2").ListObject.QueryTable.Refresh BackgroundQuery:=False
        If Sheets("Stock").Range("D3") = 0 Then
            If Sheets("Stock").Range("E3") = "BI" Then
                whereused = "BULK ISSUE"
            Else
                order_loc = Application.Match(Item.Value, Sheets("Data").Range("H1:H10000"), 0)
                order_ref = Sheets("Data").Range("A" & order_loc) & "/" & Sheets("Data").Range("B" & order_loc)
                RES = Application.Match(order_ref, Sheets("Exception Accepted").Range("A1:A10000"), 0)
                If Not IsError(RES) Then
                    whereused = "Exception Accepted"
                Else
                    whereused = Sheets("Stock").Range("E3").Value & " -###Exception###"
                End If
            End If
        Else
            whereused = "For Stock"
        End If
    End If
        
    'FIND MINIMUM FUTURE STOCK VALUE
    'SHOW ROT IF THE PARTS SHOULD BE SHOWING ON A ReOrderTab
    
    If Sheets("Future Stock").Range("F1000").End(xlUp).Offset(, 1).Value < 0 Then
        Min_value = "ROT"
    Else
        Min_value = Application.WorksheetFunction.Min(Sheets("Future Stock").Range("F6", Sheets("Future Stock").Range("F1000").End(xlUp)))
    End If
    Item.Offset(, 1).Value = whereused
    Item.Offset(, 2).Value = Min_value
    
    Next Item
    
End Sub

kgkev · Oct 24, 2022

Application.Calculation = xlCalculationManual

solved my issue. I must have added some additional formulas to other sheets that caused delays.

Speed up copy and paste

kgkev

Well-known Member

Excel Facts

johnnyL

Well-known Member

kgkev

Well-known Member

kgkev

Well-known Member

Similar threads

Forum statistics

Share this page

Speed up copy and paste

kgkev

Well-known Member

Excel Facts

johnnyL

Well-known Member

kgkev

Well-known Member

kgkev

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock