Hi Everybody
When I run a code of mine repeatedly, I keep getting this error after a certain number of iterations have gone through. The text of the error message is something to this effect :-
'The object is disconnected from its client...'
What is happening here and what can I do to fix this!
The context is this :-
I have a code that is supposed to run 200 times, once for each retail outlet. For each run, a cell value in the workbook is changed following which the entire application is recalculated - this updates the target cells and graphs associated with this dataset on a particular worksheet. This worksheet is then copied in another new workbook and then the calculated cells and the graphs are copied and pasted as values and pictures respectively. This cycle is repeated for 200 outlets.
I get this error when the processing has been completed for about 20 or thereabout retail outlets. Any suggestions what is happening here and what can be done to fix it.
The entire vba code that I have is reproduced here for general information :-
[vba]
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Option Explicit
Option Compare Text
Sub ProcessAllRetailOutlets()
Dim fd As FileDialog
Dim tempwb As Workbook
Dim reportsFolderPath As String, reportBookName As String
Dim thisReportDateText As String, thisReportDateSheetName As String
Dim thisBookOnlySheetName As String, sheetName As String, thisRetailOutletName As String
Dim selectedFolderPath As String, currentDir As String, locationPath As String, msg1 As String
Dim startRow As Long, wrkgRow As Long, finalRow As Long, retailOutletRow As Long
Dim thisReportDateRow As Long, thisReportDateCol As Long, thisReportDate As Long
Dim columnNum As Long, retailOutletCol As Long, retailTerritoryCol As Long, retailStateCol As Long
Application.CalculateFull: Application.Calculation = xlCalculationManual
msg1 = "Please specify the location of the source data for this report from the dialog box now!"
MsgBox prompt:=msg1, Buttons:=vbCritical + vbOKOnly, Title:="Select Source Model File"
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.AllowMultiSelect = False: .InitialView = msoFileDialogViewDetails
.InitialFileName = "D:\": .Show
If .SelectedItems.Count = 0 Then
MsgBox "You have not made any selection. Terminating program now!"
End
Else
selectedFolderPath = .SelectedItems.Item(1)
End If
End With
Set fd = Nothing
currentDir = CurDir(): locationPath = currentDir
msg1 = "A new folder called 'Reports' will be created at this location and will contain all the reports for various Retail Outlets!"
MsgBox prompt:=msg1, Buttons:=vbCritical + vbOKOnly, Title:="Information"
If Right(locationPath, 1) <> "\" Then
locationPath = locationPath & "\"
End If
reportsFolderPath = locationPath & "Reports\"
MkDir reportsFolderPath
sheetName = "RC"
retailOutletRow = 1: retailOutletCol = 4: retailTerritoryCol = 6: retailStateCol = 9
thisReportDateRow = 1: thisReportDateCol = 24
thisReportDateSheetName = "Criteria (RC)"
thisBookOnlySheetName = "UniqueName"
thisReportDate = Worksheets(thisReportDateSheetName).Cells(thisReportDateRow, thisReportDateCol).Value
thisReportDateText = Application.WorksheetFunction.Text(thisReportDate, "mmm yyyy")
Application.DisplayAlerts = False
'Processing at RC level
columnNum = 1: startRow = 2: wrkgRow = startRow
Worksheets("Report").Cells(retailOutletRow, retailTerritoryCol).Value = 1
Worksheets("Report").Cells(retailOutletRow, retailStateCol).Value = 1
finalRow = Worksheets(sheetName).Cells(wrkgRow, columnNum).End(xlDown).Row
Do While wrkgRow <= finalRow
'This loop is iterated around 195 times
EmptyCB
Worksheets("Report").Cells(retailOutletRow, retailOutletCol).Value = Worksheets(sheetName).Cells(wrkgRow, columnNum).Value
Application.ScreenUpdating = False
Application.CalculateFull
' Make a copy of the Graphs(RC) worksheet in a new workbook and then call the following 2 procedures
Set tempwb = Workbooks.Add(xlWBATWorksheet)
Worksheets(1).Name = thisBookOnlySheetName
ThisWorkbook.Activate
thisRetailOutletName = Worksheets(sheetName).Cells(wrkgRow, (columnNum + 1)).Value
reportBookName = thisRetailOutletName & " - " & thisReportDateText & ".xls"
tempwb.SaveAs Filename:=reportsFolderPath & thisRetailOutletName & " - " & thisReportDateText
ThisWorkbook.Activate
Worksheets("Graphs").Copy After:=Workbooks(reportBookName).Worksheets(1)
tempwb.Activate
tempwb.Sheets(thisBookOnlySheetName).Delete
ActiveWorkbook.Worksheets("Graphs").Activate
TextAsValues
CopyChartsAsPictures
Workbooks(reportBookName).Close savechanges:=True
ThisWorkbook.Activate
wrkgRow = wrkgRow + 1
Application.ScreenUpdating = True
Loop
'Processing at Territory level
columnNum = 5: startRow = 3: wrkgRow = startRow
finalRow = Worksheets(sheetName).Cells(wrkgRow, columnNum).End(xlDown).Row
Worksheets("Report").Cells(retailOutletRow, retailOutletCol).Value = 1
Worksheets("Report").Cells(retailOutletRow, retailStateCol).Value = 1
Do While wrkgRow <= finalRow
'This loop is iterated around 15 times
EmptyCB
Worksheets("Report").Cells(retailOutletRow, retailTerritoryCol).Value = Worksheets(sheetName).Cells(wrkgRow, columnNum).Value
Application.CalculateFull
'Make a copy of the Graphs(RC) worksheet in a new workbook and then call the following 2 procedures
Set tempwb = Workbooks.Add(xlWBATWorksheet)
Worksheets(1).Name = thisBookOnlySheetName
ThisWorkbook.Activate
thisRetailOutletName = Worksheets(sheetName).Cells(wrkgRow, (columnNum + 1)).Value
reportBookName = thisRetailOutletName & " - " & thisReportDateText & ".xls"
tempwb.SaveAs Filename:=reportsFolderPath & thisRetailOutletName & " - " & thisReportDateText
ThisWorkbook.Activate
Worksheets("Graphs").Copy After:=Workbooks(reportBookName).Worksheets(1)
tempwb.Activate
tempwb.Sheets(thisBookOnlySheetName).Delete
ActiveWorkbook.Worksheets("Graphs").Activate
TextAsValues
CopyChartsAsPictures
Workbooks(reportBookName).Close savechanges:=True
ThisWorkbook.Activate
wrkgRow = wrkgRow + 1
Loop
'Processing at State level
columnNum = 5: startRow = 21: wrkgRow = startRow
finalRow = Worksheets(sheetName).Cells(wrkgRow, columnNum).End(xlDown).Row
Worksheets("Report").Cells(retailOutletRow, retailOutletCol).Value = 1
Worksheets("Report").Cells(retailOutletRow, retailTerritoryCol).Value = 1
Do While wrkgRow <= finalRow
'This loop is iterated around 7 times
EmptyCB
Worksheets("Report").Cells(retailOutletRow, retailStateCol).Value = Worksheets(sheetName).Cells(wrkgRow, columnNum).Value
Application.CalculateFull
'Make a copy of the Graphs(RC) worksheet in a new workbook and then call the following 2 procedures
Set tempwb = Workbooks.Add(xlWBATWorksheet)
Worksheets(1).Name = thisBookOnlySheetName
ThisWorkbook.Activate
thisRetailOutletName = Worksheets(sheetName).Cells(wrkgRow, (columnNum + 1)).Value
reportBookName = thisRetailOutletName & " - " & thisReportDateText & ".xls"
tempwb.SaveAs Filename:=reportsFolderPath & thisRetailOutletName & " - " & thisReportDateText
ThisWorkbook.Activate
Worksheets("Graphs").Copy After:=Workbooks(reportBookName).Worksheets(1)
tempwb.Activate
tempwb.Sheets(thisBookOnlySheetName).Delete
ActiveWorkbook.Worksheets("Graphs").Activate
TextAsValues
CopyChartsAsPictures
Workbooks(reportBookName).Close savechanges:=True
ThisWorkbook.Activate
wrkgRow = wrkgRow + 1
Loop
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub TextAsValues()
Worksheets("Graphs").Activate
Range(Cells(1, 4), Cells(1, 8)).Select
Selection.Copy
Cells(1, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues
Range(Cells(6, 6), Cells(10, 8)).Select
Selection.Copy
Cells(6, 6).Select
Selection.PasteSpecial Paste:=xlPasteValues
Range(Cells(39, 3), Cells(57, 5)).Select
Selection.Copy
Cells(39, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues
Range(Cells(58, 8), Cells(60, 9)).Select
Selection.Copy
Cells(58, 8).Select
Selection.PasteSpecial Paste:=xlPasteValues
Range(Cells(4, 14), Cells(6, 17)).Select
Selection.Copy
Cells(4, 14).Select
Selection.PasteSpecial Paste:=xlPasteValues
Range(Cells(21, 14), Cells(24, 17)).Select
Selection.Copy
Cells(21, 14).Select
Selection.PasteSpecial Paste:=xlPasteValues
Range(Cells(42, 14), Cells(45, 17)).Select
Selection.Copy
Cells(42, 14).Select
Selection.PasteSpecial Paste:=xlPasteValues
End Sub
Sub CopyChartsAsPictures()
Dim myDocument As Worksheet
Dim thisObjectTop As Long, thisObjectLeft As Long
Dim thisSheetChartCount As Integer, start1 As Integer, wrkg1 As Integer
Worksheets("Graphs").Activate
ActiveSheet.Cells(1, 1).Select
Set myDocument = ActiveSheet
thisSheetChartCount = myDocument.ChartObjects.Count
start1 = 1: wrkg1 = start1
Do While wrkg1 <= thisSheetChartCount
myDocument.ChartObjects(wrkg1).Select
thisObjectTop = Selection.Top
thisObjectLeft = Selection.Left
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
ActiveSheet.Paste
Selection.ShapeRange.Top = thisObjectTop
Selection.ShapeRange.Left = thisObjectLeft
myDocument.ChartObjects(wrkg1).Select
Selection.Delete
thisSheetChartCount = thisSheetChartCount - 1
Loop
End Sub
'This code has been copied from this forum
'I thought may be clearing the clipboard is a problem but apparently not!
Sub EmptyCB()
Dim hWnd As Long
hWnd = FindWindow("XLMAIN", Application.Caption)
OpenClipboard hWnd
EmptyClipboard
CloseClipboard
End Sub
[/vba]
I am not so sure if this helps but the 5 source workbooks totalling about 150 MB have to be kept opened for the recalculations to go through. I know this is stupid but I did not create this monster - I am just trying to help some out here!
Best regards
Deepak Agarwal
Reply With Quote
