Slow VBA, Can someone please look at it?

[Nic@Rolls-Royce]

Hello Can someone please look at this script to see why its slow..


With thanks in advance



Private Sub CommandButton1_Click()
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Worksheets("Gate A").Rows("10:3000").EntireRow.Hidden = False
Worksheets("Question Database [Q]").Range("con_control").Copy
With Worksheets("Question Database [Q]")
.Range("control").PasteSpecial xlValues
End With
Dim sh As Worksheet, sh1 As Worksheet
Dim rng1 As Range, rng2 As Range, rng3 As Range
Set sh = Worksheets("Gate A")
Set sh1 = Worksheets("Question Database [Q]")
Set rng1 = sh.Range(sh.Cells(10, 1), sh.Cells(Rows.Count
1).End(xlUp))
Set rng2 = sh1.Range(sh1.Cells(1, 1), sh1.Cells(Rows.Count
1).End(xlUp))
For Each cell In rng1
Set rng3 = rng2.Find(what:=cell.Value, Lookat:=xlWhole)
If Not rng3 Is Nothing Then ' found match
cell.Offset(0, 6).Value = rng3.Offset(0, 8).Value
cell.Offset(0, 7).Value = rng3.Offset(0, 3).Value
cell.Offset(0, 8).Value = rng3.Offset(0, 9).Value
Else
cell.Offset(0, 1).Value = "No Match"
End If
Next
Worksheets("Gate A").Rows("2:3000").AutoFit
With Worksheets("Gate A")
.DisplayPageBreaks = False
StartRow = 10
EndRow = 3000
For Lrow = EndRow To StartRow Step -1
If IsError(.Cells(Lrow, "G").Value) Then
'Do nothing, This avoid a error if there is a error in the cell
ElseIf .Cells(Lrow, "G").Value = "" Then .Rows(Lrow).EntireRow.Hidden
True

End If
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub



BTW

Above where I have 'With Worksheets("Question Database [Q]")'
can I secify a file as well like:- "Database spreadsheet\Questio
Database [Q]"


??


Ni

 

[David McRitchie]

Hi Nic,
I would turn off Page Breaks at the start of macro, not after changing row heights.