Slow Processing Code

lkrznchc

New Member
Hi all,

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

Code:
``````'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.

Code:
``````    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?

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
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()

Replies
9
Views
269
Replies
2
Views
223
Replies
2
Views
238
Replies
2
Views
88
Replies
6
Views
631

1,196,254
Messages
6,014,273
Members
441,810
Latest member
LouLou1234

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.

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

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