Macros slowing down

[Adam87]

Good morning

I am new to both the art of Excel Macro writing and also to this board. I have run several searches on this topic but cannot find a thorough answer (although I am aware it may be out there but 'lost').

I have a macro I have written (code below) to pull data out of some lists and populate this Front End based on the store number eneterd by the user. The first time this is run (each time I load Excel) it runs swiftly - that is sub 1 second. On subsequent runs however it slows down considerably.

I have added in the bits of advice I could find on removing screen calculation and automatic calculation. I am unsure if there is a quick fix to this problem or if my code is merely too unwieldy for the task I am trying to achieve and if I should be going about the whole matter in a different way.

All suggestions gratefully received

Private Sub cmdExecute_Click()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' On Error GoTo errorhandler
 
With Worksheets("frontend").Rows("6:50")
 .ClearContents
 .RowHeight = 15
 .Interior.ColorIndex = xlNone
 .Interior.Pattern = xlNone
 .Interior.PatternColorIndex = xlNone
 .Font.Underline = False
 .Font.Bold = False
 .Font.Name = "Arial"
 .Font.Color = 0
End With
 
 ' Find number of columns
 Dim c As Integer
 c = 0
 Do While Worksheets("data").Cells(1, c + 1) > 0
 c = c + 1
 Loop

Dim inprtn As String
Dim locno As Integer
Dim rowno As Integer

rowno = 6
inprtn = InputBox("Enter Store Number", , Worksheets("Frontend").Range("a3"))
If inprtn = "" Then Exit Sub
locno = Val(inprtn)

 For a = 1 To c
  If Worksheets("data").Range("A3:BG1000").Find(locno).Cells.Offset(columnoffset:=a + 2) = 1 Then
   With Worksheets("frontend")
    
    With .Rows(rowno)
     .RowHeight = 15
     .Interior.ColorIndex = xlNone
     .Interior.Pattern = xlSolid
     .Interior.PatternColorIndex = xlAutomatic
    End With
    
    .Cells(rowno, 2) = Worksheets("projectlookups").Cells(a + 3, 3)
    .Cells(rowno, 1) = Worksheets("projectlookups").Cells(a + 3, 1)
    .Cells(rowno, 3) = Worksheets("projectlookups").Cells(a + 3, 4)
    
    If Worksheets("Projectlookups").Cells(a + 3, 5) <> "" Then _
     Worksheets("frontend").Hyperlinks.Add Worksheets("frontend").Cells(rowno, 2), Worksheets("projectlookups").Cells(a + 3, 5)
    
    rowno = rowno + 1
    
    With .Rows(rowno)
     .RowHeight = 15
     .Interior.ColorIndex = xlNone
     .Interior.Pattern = xlSolid
     .Interior.PatternColorIndex = xlAutomatic
    End With
    
    .Cells(rowno, 2) = "More info"
    .Cells(rowno, 3) = "Lets put finance details here"
    
    rowno = rowno + 1
    
    With .Rows(rowno)
     .RowHeight = 3
     .Interior.ColorIndex = 1
     .Interior.Pattern = xlSolid
     .Interior.PatternColorIndex = xlAutomatic
    End With
    
    rowno = rowno + 1
   
   End With
   
  End If
  
 Next

're-format
With Worksheets("Frontend")
 .Range("A:A").ColumnWidth = 0
 .Range("b3") = locno & " : " _
   & Worksheets("data").Range("A3:BG1000").Find(locno).Cells.Offset(columnoffset:=1) & " : " _
   & Worksheets("data").Range("A3:BG1000").Find(locno).Cells.Offset(columnoffset:=2)
 .Range("a3") = locno
 .Columns("B:C").Columns.AutoFit
 .Range("B6:C50").HorizontalAlignment = xlLeft
 .PageSetup.PrintArea = "A:C"
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Exit Sub
 
errorhandler:
 MsgBox ("Enter a valid store number")
 Worksheets("frontend").Range("A3:F50").ClearContents
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
End Sub

Thank you in advance for your helpful replies!

/AJ[/code]

 

[Adam87]

Bump for the afternoon crowd...