Code running amazing slow when file is shared

[KGilbert]

All,

I have a spread sheet that I fill combo box off of a sorted and filtered list. When the file is not shared it runs in less than a second, however once it is share it seems to slow down in the below section of code and I can't for the life of me figure out why. I have remove parts of the code and still no luck, maybe I have been looking at it too long. Any help would be appreciated.



[vba]Private Sub ComboBox02_Click()
Dim lr5, lr6, lr10 As Long
Dim item3 As Range
'Application.ScreenUpdating = False
Sheets("Analysis").Select
ActiveSheet.Range("ac2:Ac5").Select
Selection.Clear
ThisWorkbook.Sheets("Processing Sheet").Visible = True
Sheets("Processing Sheet").Select
oo:
If Not ActiveSheet.AutoFilter.Filters(43).On Then
ActiveSheet.Range("B:B").Select
Selection.AutoFilter Field:=2, Criteria1:=Sheets("Analysis").Range("C3")
Sheets("Formula Sheet").Visible = True
Sheets("Formula Sheet").Select
tttt:
ActiveSheet.FilterMode = True
ActiveSheet.ShowAllData
Sheets("Processing Sheet").Select
ActiveSheet.Range("AQ:AQ").Select 'added by ktg to make the scope and active list
Selection.Copy
Sheets("Formula Sheet").Select
ActiveSheet.Range("w1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
lr5 = Sheets("Formula Sheet").Cells(Rows.Count, "W").End(xlUp).Row
ActiveWorkbook.Worksheets("Formula Sheet").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Formula Sheet").Sort.SortFields.Add Key:=Range( _
"w1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Formula Sheet").Sort
.SetRange Range("w1" & ":w" & lr5)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'lr6 = Sheets("Formula Sheet").Cells(Rows.Count, "W").End(xlUp).Row
ActiveSheet.Range("x2" & ":" & "x" & lr5).Select
Selection.Clear
Selection.FormulaR1C1 = "=IF(R[-1]C[-1]=RC[-1],R[-1]C+1,1)"
ActiveSheet.Range("x:x").Select 'set column you filter for probable names here
Selection.AutoFilter Field:=7, Criteria1:="1" 'end of add
ActiveSheet.Range("w1" & ":w" & lr5).Select
Selection.Copy
Sheets("Analysis").Select
ActiveSheet.Range("Ac1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Else
'ActiveSheet.ShowAllData
'GoTo tttt:
'End If
Sheets("Analysis").ComboBox03.Clear
'Sheets("Analysis").ComboBox03.AddItem "(Select All)"
lr10 = Sheets("Analysis").Cells(Rows.Count, "Ac").End(xlUp).Row
For Each item3 In Sheets("analysis").Range("AC2" & ":AC" & lr10)
Sheets("Analysis").ComboBox03.AddItem item3.Value
Next item3
Else
'Need to work on this
ActiveSheet.Range("$A$1:$BA$7633").AutoFilter Field:=43
GoTo oo:
End If
'If ActiveSheet.Range("c4").Value = "" Then
'ActiveSheet.ComboBox03.Value = "Select a Scope"
'Else
ActiveSheet.ComboBox03.Value = "Select a Scope"
'End If
ThisWorkbook.Sheets("Processing Sheet").Visible = False
'Application.ScreenUpdating = True
ActiveSheet.Range("B5").Select
End Sub[/vba]

[Aussiebear]

Welcome to the VBAX forum. Try the following
[VBA]
Private Sub ComboBox02_Click()
Dim lr5, lr6, lr10 As Long
Dim item3 As Range
'Application.ScreenUpdating = False
Sheets("Analysis").Range("ac2:Ac5").Clear
ThisWorkbook.Sheets("Processing Sheet").Visible = True
Sheets("Processing Sheet").Select
oo:
If Not ActiveSheet.AutoFilter.Filters(43).On Then
ActiveSheet.Range("B:B").AutoFilter Field:=2, Criteria1:=Sheets("Analysis").Range("C3")
Sheets("Formula Sheet").Visible = True
Sheets("Formula Sheet").Select
tttt:
ActiveSheet.FilterMode = True
ActiveSheet.ShowAllData
'added by ktg to make the scope and active list
Sheets("Processing Sheet").Range("AQ:AQ").Copy
Sheets("Formula Sheet").Range("w1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
lr5 = Sheets("Formula Sheet").Cells(Rows.Count, "W").End(xlUp).Row
ActiveWorkbook.Worksheets("Formula Sheet").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Formula Sheet").Sort.SortFields.Add Key:=Range( _
"w1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Formula Sheet").Sort
.SetRange Range("w1" & ":w" & lr5)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'lr6 = Sheets("Formula Sheet").Cells(Rows.Count, "W").End(xlUp).Row
ActiveSheet.Range("x2" & ":" & "x" & lr5).Clear
.FormulaR1C1 = "=IF(R[-1]C[-1]=RC[-1],R[-1]C+1,1)"
'set column you filter for probable names here
ActiveSheet.Range("x:x").AutoFilter Field:=7, Criteria1:="1" 'end of add
ActiveSheet.Range("w1" & ":w" & lr5).Copy
Sheets("Analysis").Range("Ac1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Else
'ActiveSheet.ShowAllData
'GoTo tttt:
'End If
Sheets("Analysis").ComboBox03.Clear
'Sheets("Analysis").ComboBox03.AddItem "(Select All)"
lr10 = Sheets("Analysis").Cells(Rows.Count, "Ac").End(xlUp).Row
For Each item3 In Sheets("analysis").Range("AC2" & ":AC" & lr10)
Sheets("Analysis").ComboBox03.AddItem item3.Value
Next item3
Else
'Need to work on this
ActiveSheet.Range("$A$1:$BA$7633").AutoFilter Field:=43
GoTo oo:
End If
'If ActiveSheet.Range("c4").Value = "" Then
'ActiveSheet.ComboBox03.Value = "Select a Scope"
'Else
ActiveSheet.ComboBox03.Value = "Select a Scope"
'End If
ThisWorkbook.Sheets("Processing Sheet").Visible = False
'Application.ScreenUpdating = True
ActiveSheet.Range("B5").Select
End Sub

[/VBA]