Slow Processing Code

[lkrznchc]

Hi all,

I have written the following code and am unhappy with how slow it takes to process.

'Sorts transmitter by PSIA, PSI, in H2O, deg F
Sub TransmitterSort()
    Dim countA As Integer, countI As Integer, countO As Integer, countF As Integer
    Dim num_xmitters As Integer
    Dim xmitter_type As String
    Dim InstrSortArray(1 To 5, 1 To 50) As String
    Dim InstrInfoArray() As String
        
    num_xmitters = ThisWorkbook.Worksheets("Instr List").Range("B3:B1000").Cells.SpecialCells(xlCellTypeConstants).Count
    ReDim InstrInfoArray(1 To num_xmitters, 1 To 7)
    
    'compares the last character in transmitter range column on instr list and sorts according to PSIA, PSI, inH2O, deg F
        countA = 1: countI = 1: countO = 1: countF = 1
    For j = 1 To num_xmitters
        xmitter_type = Right(Trim(ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 5).Value), 1)
        Select Case xmitter_type
            Case "A"
                If countA > 50 Then
                    msgBox "Too Many Absolute Pressure Transmitters", vbOKOnly, "Warning"
                Else
                    InstrSortArray(1, countA) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 2).Value
                End If
                countA = countA + 1
               
            Case "I"
                If countI > 50 Then
                    msgBox "Too Many Gauge Pressure Transmitters", vbOKOnly, "Warning"
                Else
                    InstrSortArray(2, countI) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 2).Value
                End If
                countI = countI + 1
               
            Case "O"
                If countO > 50 Then
                    msgBox "Too Many Differential Pressure Transmitters", vbOKOnly, "Warning"
                Else
                    InstrSortArray(3, countO) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 2).Value
                End If
                countO = countO + 1
                
            Case "F"
                If countF > 100 Then
                    msgBox "Too Many Temperature Transmitters", vbOKOnly, "Warning"
                ElseIf countF > 50 Then
                    InstrSortArray(5, countF - 50) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 2).Value
                Else: InstrSortArray(4, countF) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 2).Value
                End If
                countF = countF + 1
        End Select
        'Pastes Instrument Information underneath the sorted Test Point IDs
        InstrInfoArray(j, 1) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 2).Value
        InstrInfoArray(j, 2) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 4).Value
        InstrInfoArray(j, 3) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 7).Value
        InstrInfoArray(j, 4) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 5).Value
        InstrInfoArray(j, 5) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 9).Value
        InstrInfoArray(j, 6) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 10).Value
        InstrInfoArray(j, 7) = ThisWorkbook.Worksheets("Instr List").Cells(j + 2, 11).Value
    Next j
    'Clears previous values
    ThisWorkbook.Worksheets("Instr Sort").Range("C4:AZ7").ClearContents
    ThisWorkbook.Worksheets("Instr Sort").Range("A11:L1000").ClearContents
    
    ThisWorkbook.Worksheets("Raw Data").Range("B4:AY4").ClearContents
    ThisWorkbook.Worksheets("Raw Data").Range("B14:AY14").ClearContents
    ThisWorkbook.Worksheets("Raw Data").Range("B24:AY24").ClearContents
    ThisWorkbook.Worksheets("Raw Data").Range("B34:AY34").ClearContents
    ThisWorkbook.Worksheets("Raw Data").Range("B45:AY45").ClearContents
    
    'Pastes new values
    ThisWorkbook.Worksheets("Instr Sort").Range("C4:AZ7").Value = InstrSortArray()
   
    ThisWorkbook.Worksheets("Raw Data").Range("B4:AY4").Value = ThisWorkbook.Worksheets("Instr Sort").Range("C4:BQ4").Value
    ThisWorkbook.Worksheets("Raw Data").Range("B14:AY14").Value = ThisWorkbook.Worksheets("Instr Sort").Range("C5:BQ5").Value
    ThisWorkbook.Worksheets("Raw Data").Range("B24:AY24").Value = ThisWorkbook.Worksheets("Instr Sort").Range("C6:BQ6").Value
    ThisWorkbook.Worksheets("Raw Data").Range("B34:AY34").Value = ThisWorkbook.Worksheets("Instr Sort").Range("C7:BQ7").Value
    ThisWorkbook.Worksheets("Raw Data").Range("B45:AY45").Value = ThisWorkbook.Worksheets("Instr Sort").Range("C8:BQ8").Value
    i = 1
    j = 1
    For i = 1 To num_xmitters
        For j = 1 To 7
            ThisWorkbook.Worksheets("Instr Sort").Cells(10 + i, j) = InstrInfoArray(i, j)
        Next j
    Next i
End Sub

Using the debug tool i have found that defining the values of the custom array occurs quite quickly, but anytime the procedure clears contents of a range on the sheet and writes values to the sheet the process slows down immensely. The longest duration loop of the code is the final nested for-next loop.

    i = 1
    j = 1
    For i = 1 To num_xmitters
        For j = 1 To 7
            ThisWorkbook.Worksheets("Instr Sort").Cells(10 + i, j) = InstrInfoArray(i, j)
        Next j
    Next i

Is there a way to allow the code to process more quickly?

 

[lkrznchc]

I was able to remove the for loop and just paste the array into a range using

ThisWorkbook.Worksheets("Instr Sort").Range(Cells(11, 1), Cells(num_xmitters, 7)).Value = InstrInfoArray()