Morning all,
Really stuck with this one and will appreciate any of your knowledge,
I have a function that run's in Excel that call's other macros and it involves locking ranges, dimming various items and hiding sheets, Please see below.
The problem I am having is with the Function Product_Database_Open_Without_Sync_Option() macro,
If I run it on it;s own it works fine and completes in a second, however when it runs after all the below - I get the excel cannot complete with all available resources message,
Is there a way I can somehow reset Excel or release the Dim statements or similar to allow this to run correctly?
Thanks
Jamie
Private Sub CommandButton8_Click()
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
' Promt
strPrompt = "Are You Sure You Want To Update The PHI Forecasting Product List?"
' Dialog's Title
strTitle = "Secondary Check"
'Display MessageBox
iRet = MsgBox(strPrompt, vbYesNo, strTitle)
' Check pressed button
If iRet = vbNo Then
GoTo TheEnd
Else
Application.ScreenUpdating = False
ProductDatabaseForm.Hide
'gets rid of any blanks
Application.Run "Product_Database_Ensure_No_Blanks"
Sheets("Product Database").Select
activesheet.Unprotect Password:="itsasecret"
'unhides calculation parts
Columns("DN:EV").Select
Selection.EntireColumn.Hidden = False
Application.Run "General_Unhide_All"
Application.Run "Product_Database_Update_PHI_Product_List"
MsgBox "The List Has Been Updated Successfully", vbInformation, "Demand Planning System"
Application.Run "Product_Database_Open_Without_Sync_Option"
End If
TheEnd:
End Sub
Private Function General_Unhide_All()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "No Name" Then ws.Visible = True
Next
End Function
Function Product_Database_Update_PHI_Product_List()
'
' Forecasting_Update_PHI_Product_List Macro
'
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Product Database").Select
Range("EJ3:EJ5002").Select
Selection.ClearContents
Sheets("PHI Product List Calculation").Select
Columns("A:E").Select
Selection.AutoFilter
Columns("A:E").Select
Selection.ClearContents
Sheets("Product Database").Select
Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Select
Selection.Copy
Sheets("PHI Product List Calculation").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
ActiveCell.FormulaR1C1 = " "
Range("B1").Select
ActiveCell.FormulaR1C1 = "2"
Range("C1").Select
ActiveCell.FormulaR1C1 = "3"
Range("D1").Select
ActiveCell.FormulaR1C1 = "4"
Range("E1").Select
ActiveCell.FormulaR1C1 = "5"
Range("F1").Select
Columns("A:E").Select
Application.CutCopyMode = False
Selection.AutoFilter
activesheet.Range("$A$1:$E$5002").AutoFilter Field:=5, Criteria1:="=*PHI*", _
Operator:=xlAnd
ActiveWorkbook.Worksheets("PHI Product List Calculation").AutoFilter.Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("PHI Product List Calculation").AutoFilter.Sort. _
SortFields.Add Key:=Range("A1:A5002"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("PHI Product List Calculation").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:A").Select
Selection.Copy
Sheets("Product Database").Select
Range("EJ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("EJ4:EJ5002").Select
Selection.Copy
Range("EJ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("EJ5002").Select
Selection.ClearContents
Application.DisplayAlerts = True
End Function
Function Product_Database_Open_Without_Sync_Option()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Product Database" Then ws.EnableCalculation = False
Next
Sheets("Product Database Open Calc").EnableCalculation = True
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> "Product Database" Then ws.Visible = xlSheetVeryHidden
Next
Sheets("Product Database").Select
Range("A3:A5002,C3:C5002,E3:G5002,I3:U5002,AQ3:AS5002").Select
Selection.Locked = False
Cells.Select
Selection.FormulaHidden = True
'hides calculation parts
Columns("DN:EV").Select
Selection.EntireColumn.Hidden = True
activesheet.Protect Password:="itsasecret"
ActiveWindow.ScrollColumn = 123
ActiveWindow.ScrollColumn = 114
ActiveWindow.ScrollColumn = 90
ActiveWindow.ScrollColumn = 73
ActiveWindow.ScrollColumn = 63
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 3
ActiveWindow.SmallScroll Down:=-238
Range("B3").Select
Application.CutCopyMode = False
End Function
Really stuck with this one and will appreciate any of your knowledge,
I have a function that run's in Excel that call's other macros and it involves locking ranges, dimming various items and hiding sheets, Please see below.
The problem I am having is with the Function Product_Database_Open_Without_Sync_Option() macro,
If I run it on it;s own it works fine and completes in a second, however when it runs after all the below - I get the excel cannot complete with all available resources message,
Is there a way I can somehow reset Excel or release the Dim statements or similar to allow this to run correctly?
Thanks
Jamie
Private Sub CommandButton8_Click()
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String
' Promt
strPrompt = "Are You Sure You Want To Update The PHI Forecasting Product List?"
' Dialog's Title
strTitle = "Secondary Check"
'Display MessageBox
iRet = MsgBox(strPrompt, vbYesNo, strTitle)
' Check pressed button
If iRet = vbNo Then
GoTo TheEnd
Else
Application.ScreenUpdating = False
ProductDatabaseForm.Hide
'gets rid of any blanks
Application.Run "Product_Database_Ensure_No_Blanks"
Sheets("Product Database").Select
activesheet.Unprotect Password:="itsasecret"
'unhides calculation parts
Columns("DN:EV").Select
Selection.EntireColumn.Hidden = False
Application.Run "General_Unhide_All"
Application.Run "Product_Database_Update_PHI_Product_List"
MsgBox "The List Has Been Updated Successfully", vbInformation, "Demand Planning System"
Application.Run "Product_Database_Open_Without_Sync_Option"
End If
TheEnd:
End Sub
Private Function General_Unhide_All()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "No Name" Then ws.Visible = True
Next
End Function
Function Product_Database_Update_PHI_Product_List()
'
' Forecasting_Update_PHI_Product_List Macro
'
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Product Database").Select
Range("EJ3:EJ5002").Select
Selection.ClearContents
Sheets("PHI Product List Calculation").Select
Columns("A:E").Select
Selection.AutoFilter
Columns("A:E").Select
Selection.ClearContents
Sheets("Product Database").Select
Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Select
Selection.Copy
Sheets("PHI Product List Calculation").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
ActiveCell.FormulaR1C1 = " "
Range("B1").Select
ActiveCell.FormulaR1C1 = "2"
Range("C1").Select
ActiveCell.FormulaR1C1 = "3"
Range("D1").Select
ActiveCell.FormulaR1C1 = "4"
Range("E1").Select
ActiveCell.FormulaR1C1 = "5"
Range("F1").Select
Columns("A:E").Select
Application.CutCopyMode = False
Selection.AutoFilter
activesheet.Range("$A$1:$E$5002").AutoFilter Field:=5, Criteria1:="=*PHI*", _
Operator:=xlAnd
ActiveWorkbook.Worksheets("PHI Product List Calculation").AutoFilter.Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("PHI Product List Calculation").AutoFilter.Sort. _
SortFields.Add Key:=Range("A1:A5002"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("PHI Product List Calculation").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:A").Select
Selection.Copy
Sheets("Product Database").Select
Range("EJ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("EJ4:EJ5002").Select
Selection.Copy
Range("EJ3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("EJ5002").Select
Selection.ClearContents
Application.DisplayAlerts = True
End Function
Function Product_Database_Open_Without_Sync_Option()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Product Database" Then ws.EnableCalculation = False
Next
Sheets("Product Database Open Calc").EnableCalculation = True
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> "Product Database" Then ws.Visible = xlSheetVeryHidden
Next
Sheets("Product Database").Select
Range("A3:A5002,C3:C5002,E3:G5002,I3:U5002,AQ3:AS5002").Select
Selection.Locked = False
Cells.Select
Selection.FormulaHidden = True
'hides calculation parts
Columns("DN:EV").Select
Selection.EntireColumn.Hidden = True
activesheet.Protect Password:="itsasecret"
ActiveWindow.ScrollColumn = 123
ActiveWindow.ScrollColumn = 114
ActiveWindow.ScrollColumn = 90
ActiveWindow.ScrollColumn = 73
ActiveWindow.ScrollColumn = 63
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 24
ActiveWindow.ScrollColumn = 22
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 3
ActiveWindow.SmallScroll Down:=-238
Range("B3").Select
Application.CutCopyMode = False
End Function