Need for performance boost

  • Thread starter Thread starter chris
  • Start date Start date
C

chris

I have a macro that could really use a performance boost. It executes
the following actions on roughly between 400 and 2000 cells in
different columns:
- extract parts of the cell contents using instr, left, right, mid
functions and copy those to other cells
- apply formatting (background, font colour ...) to those cells based
upon their contents

I followed normal performance suggestions such as
- using object variables where possible (e.g. for ranges)
- never using copy but range.offset()=

However, it still takes (too) long to execute the macro. Are there any
other tips to improve speed? Is it possible to replace the For each
.... in Range I use to loop through all cells with a more efficient
approach?

Tia,
Chris
 
You could pick up all your cells into an array in one command and then
process the array - building another array which you could then place back
on the spreadsheet. This would depend on where you source and destination
cells are.

Without seeing what your code looks like, it would be hard to make specific
suggestions.
 
Thanks for your suggestion, Tom. I can surely use it for the string
processing actions of the macro. But I was wondering if this would
also work for the formatting part, where I need to check each
individual cell.
I include part of the code which I think is relevant (left out the
variable declarations). It would be great if you or someone else could
have a short look at it from the performance point of view.
Chris


Private Sub cmdInitialiseren_Click()

Set rngStart = sh.Range("A1")

For x = 1 To intKlassen ‘number of columns to process
With rngStart
.offset(0, x * intKols - 1).HorizontalAlignment = xlRight
.offset(0, x * intKols - 2).ColumnWidth = 4.5
.offset(0, x * intKols - 1).ColumnWidth = 4.2
.offset(0, x * intKols - 0).ColumnWidth = 0


'details
For Y = 0 To intVakken ‘number of rows to process
blnComment = False
Set rngUren = .offset(Y + 5, x * intKols - 1)

If Len(rngUren) > 0 Then 'rngUren contains string to
process
Set rngNr = rngUren.offset(0, 1)
Set rngLkr = rngUren.offset(0, -1)
intPos1 = InStr(rngUren, "%")
intPos2 = InStr(rngUren, "\")
intPos3 = InStr(rngUren, "{")
intPos4 = InStr(rngUren, "§")
intPos5 = InStr(rngUren, "#")

With rngLkr
.Value = Left(rngUren, intPos1 - 1)
If Len(rngLkr) = 0 Then
.Interior.ColorIndex = 36
End If
strTmp = Mid(rngUren, intPos3 + 1, intPos4 -
intPos3 - 1)
If Len(strTmp) > 6 Then
blnComment = True
.AddComment strTmp
End If
End With

rngNr = Mid(rngUren, intPos2 + 1, intPos3 - intPos2 -
1)

strKlasToegekend = Mid(rngUren, intPos5 + 1, 100)

sglUrenToegekend = Mid(rngUren, intPos4 + 1, intPos5 -
intPos4 - 1)
With rngUren
.Value = Replace(Mid(rngUren, intPos1 + 1, intPos2
- intPos1 - 1), ",", ".")
If .Value = 0 Then
.ClearContents
.Interior.ColorIndex = 36
Else
.Interior.ColorIndex = 40
End If
If .Value = sglUrenToegekend And sglUrenToegekend
0 Then
Click to expand...
.Font.Bold = True
If Len(rngLkr) > 0 Then
rngLkr.Interior.ColorIndex = 40
rngLkr.Font.Bold = True
End If
If blnComment And strKlasToegekend =
rngStart.offset(0, x * intKols - 1) Then
.Font.Underline = True
End If
End If
End With
End If
Next Y

End With

Next x


End Sub
 
Thanks for replying, Pancho. I should have added that I already
switched off automatic calculation and screen updating.
Chris
 
Thanks for the suggestion Tom. I'm still thinking about the array
approach. Could you give me an indication whether I would gain
performance if I still have to loop through all cells for the
formatting.
Thanks a lot,
Chris
 
Back
Top