Slow code.... Any thoughts on how to speed it up?

[Bruce]

I have written some code to walk through a spreadsheet, compare 1 cell value
to the following row, if it is the same, then to compare a second cell
value, see if it is included in a teststring, if not to add that value to a
teststring, and then continue looping - testing the first value. When that
is done, to go to the first instance of the fist value, replace a cell in
each occurance of that value, and then go to the next record. (I hope that
was not TOO confusing....)
WS is sorted by firstvalue and then by the second value. I am using EXCEL
2007. The statusbar is just for testing so I can see what is going on. I can
be removed.

Below is the code I have written. Is there a better way to do this? based on
the display of the statusbar, it seems to be very slow during the "FILLING"
loop.

Sub stepthrough()
Dim iRecCount, sString, iCnt

iRecCount = LastRow(Worksheets("Sheet1")) - 1
sString = ""
'temp = MsgBox(iRecCount)
iCnt = 2
tester1 = Worksheets("Sheet1").Cells(iCnt, 93).Value
' P = MsgBox(tester1)

Do
tester1 = Worksheets("Sheet1").Cells(iCnt, 93).Value

counter = 0
' Loop while KEY (Col 93) remains the same
Do While Worksheets("Sheet1").Cells(iCnt + counter, 93).Value = tester1
'If Catagories is not found in the existing sString, then add it.
(need to later on parse
'each item in the active catagory
If
Application.IsError(Application.Find(Worksheets("Sheet1").Cells(iCnt +
counter, 55).Value, sString)) Then
sString = sString & "; " & Worksheets("Sheet1").Cells(iCnt +
counter, 55).Value
End If
Application.StatusBar = CStr(iCnt) & " of " & CStr(iRecCount) & " |
building CAT:for " & " " & counter & " | "
' & tester1

counter = counter + 1 'count how many records have the KEY
Loop

counter = 0

' again, loop through the same records, and then set need column to the
new catigory list
Do While Worksheets("Sheet1").Cells(iCnt + counter, 93).Value = tester1
Worksheets("Sheet1").Cells(iCnt + counter, 103).Value = sString
counter = counter + 1
Application.StatusBar = CStr(iCnt) & " of " & CStr(iRecCount)
& " | FILLING CAT:for " & " " & counter & " | "
'& tester1

Loop

iCnt = iCnt + counter

sString = ""

tester1 = ""

Worksheets("Sheet1").Cells(iCnt, 106).Value = sString

'iCnt = iCnt + 1
Application.StatusBar = CStr(iCnt) & " of " & CStr(iRecCount) & " | "


Loop Until iCnt > iRecCount

 

[Bob Phillips]

Why not incorporate the second loop into the first, and maybe turn automatic
recalculation off.

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Bruce]

Why not incorporate the second loop into the first,
BEcuase I would not know what the whole sString would be yet.

Can you fill a RANGE? something like
Dim myRange As Range
Set myRange = Worksheets("Sheet1").Range("CO" & icnt & ":CO" & iCnt +
counter) 'Do I need to adjust counter after the build loop?
myRange.valuve = sString

Would this be quicker?

Thanks

 

[JE McGimpsey]

If I understand you correctly (and I'm not sure I do) here's one way::

Public Sub stepthrough()
Const csDELIM = "; "
Const cnCATCOL As Long = 55
Const cnKEYCOL As Long = 93
Const cnNEEDCOL As Long = 103
Const cnSTARTROW As Long = 2

Dim vKey As Variant
Dim nBeginKeyRow As Long
Dim i As Long
Dim sCats As String
Dim sTemp As String

With Worksheets("Sheet1")
nBeginKeyRow = cnSTARTROW
vKey = .Cells(nBeginKeyRow, cnKEYCOL).Value
sCats = .Cells(nBeginKeyRow, cnCATCOL).Text
For i = cnSTARTROW + 1 To _
.Cells(.Rows.Count, cnKEYCOL).End(xlUp).Row - 1
If .Cells(i, cnKEYCOL) = vKey Then
sTemp = .Cells(i, cnCATCOL).Text
If InStr(LCase(sCats), LCase(sTemp)) = 0 Then _
sCats = sCats & csDELIM & sTemp
Else
.Cells(nBeginKeyRow, cnNEEDCOL).Resize( _
i - nBeginKeyRow, 1).Value = sCats
nBeginKeyRow = i
vKey = .Cells(nBeginKeyRow, cnKEYCOL)
sCats = .Cells(i, cnCATCOL)
End If
Next i
.Cells(nBeginKeyRow, cnNEEDCOL).Resize( _
i - nBeginKeyRow + 1, 1).Value = sCats
End With
End Sub

 

[JE McGimpsey]

Better (I think):

Public Sub stepthrough()
Const csDELIM = "; "
Const cnCATCOL As Long = 55
Const cnKEYCOL As Long = 93
Const cnNEEDCOL As Long = 103
Const cnSTARTROW As Long = 2

Dim vKey As Variant
Dim nBeginKeyRow As Long
Dim i As Long
Dim sCats As String
Dim sTemp As String

With Worksheets("Sheet1")
nBeginKeyRow = cnSTARTROW
vKey = .Cells(nBeginKeyRow, cnKEYCOL).Value
sCats = .Cells(nBeginKeyRow, cnCATCOL).Text
For i = cnSTARTROW + 1 To _
.Cells(.Rows.Count, cnKEYCOL).End(xlUp).Row - 1
If .Cells(i, cnKEYCOL) = vKey Then
sTemp = .Cells(i, cnCATCOL).Text
If InStr(LCase(sCats), LCase(sTemp)) = 0 Then _
sCats = sCats & csDELIM & sTemp
Else
.Cells(nBeginKeyRow, cnNEEDCOL).Resize( _
i - nBeginKeyRow, 1).Value = sCats
nBeginKeyRow = i
vKey = .Cells(nBeginKeyRow, cnKEYCOL).Value
sCats = .Cells(i, cnCATCOL).Text
End If
Next i
.Cells(nBeginKeyRow, cnNEEDCOL).Resize( _
i - nBeginKeyRow, 1).Value = sCats
End With
End Sub