Poundland
06-28-2016, 07:52 AM
Hi all,
Some time ago you were gracious in helping me with some time based looping code. I have adapted this but have found that a certain workbook that opens and runs a macro during the loop causes the loop to fall over and not complete. I don't think it is to do with opening and closing workbooks as there are two more that open, run macros, and then close before the one that causes the loop to end.
I am baffled as to why this particular work book causes the issue.
Can you help and look over my code below and tell me where you think the issue is as to why the Time Loop is falling over.
Below is the Time Loop code. I have highlighted in Bold text the Call Routine that makes the Time Loop fall over. I have attached this workbook.
Option Explicit
Dim KeepRunning As Boolean
Dim BookRunning As Boolean
Sub ScheduleMacroStart()
Debug.Print "started running Emails -- " & Now
KeepRunning = True
Application.OnTime Date + TimeValue("08:35"), "allemailsandcompile"
End Sub
Sub ScheduleMacroEnd()
Debug.Print "stopped running Emails -- " & Now
KeepRunning = False
End Sub
Sub allemailsandcompile() ' checks to see if all the emails have been captured
Dim pdat As Date, Monday As String, pdat2 As Date, Count As Long
If Not KeepRunning Then Exit Sub '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Debug.Print "still running -- " & Now
Application.OnTime Now + TimeValue("00:01:00"), "allemailsandcompile"
pdat = Format(Now, "dd/mm/yyyy")
Monday = DateAdd("ww", -1, pdat - (Weekday(pdat, vbMonday) - 8))
If pdat = Monday Then pdat2 = Format(Now - 3, "dd/mm/yyyy") Else pdat2 = Format(Now - 1, "dd/mm/yyyy")
Count = 0
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(Monday, "dd.mm.yyyy") & " Automated Stock Ledger By Dept.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call stockledger
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Availability Measurement by SKU.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call SkuAvailability
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Availability Measurement by Store.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call storeavailability
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " SKU Range Daily Availability Summary.pdf", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call dailyrangesummary
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Essentials Overstock " & Format(pdat, "dd.mm.yyyy") & ".xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call awrreports
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Essentials at Risk " & Format(pdat, "dd.mm.yyyy") & ".xlsm", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call awrreports
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " SKU Range Daily Availability.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call skurangefullversion
Call Update_Availability
Call Demographics
Call Category_Split ''''''' THIS ROUTINE CAUSES THE LOOP TO FALL OVER
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Booking Detail Report.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call Bookings
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Supplier to DC Delivery Issues " & Format(pdat2, "ddmmyy") & ".xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call dcfaileddelivery
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Slots Report.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call Slots
End If
If Count = 10 Then
Call ScheduleMacroEnd
Else
End If
End Sub
Sub Category_Split()
Application.ScreenUpdating = False
Workbooks.Open ("P:\H925 Buying\Dashboard Reports\Category Splits.xlsm")
Application.ScreenUpdating = False
End Sub
And Below is the Code on the workbook that is run when the workbook opens. I could not attach this workbook as it would not upload for some reason.
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
Dim StartCell As Range
Dim Rng As Range
Sub Start()
Call Update
Call Food_Availability
ThisWorkbook.Close False
End Sub
Dim Data_sht As Worksheet '
Dim Pivot_sht_Stock As Worksheet
Dim Pivot_sht_Sales As Worksheet
Dim Pivot_sht_Avail As Worksheet
Dim StartPoint As Range
Dim DataRange As Range ''
Dim shtStockPivotName As String
Dim shtSalesPivotName As String
Dim shtAvailPivotName As String
Dim NewRange As String
Sub Update()
Dim wrkRange As Workbook, shtRange As Worksheet, shtDestn As Worksheet
Dim rngRange As Range, rngDestn As Range, pdat As Date
pdat = Format(Now, "dd/mm/yyyy")
Set shtDestn = ThisWorkbook.Sheets("Sheet1")
With shtDestn
.Cells.ClearContents
End With
Set rngDestn = shtDestn.Cells(1, 1)
Set wrkRange = Workbooks.Open("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " SKU Range Daily Availability.xlsx")
Set shtRange = wrkRange.Sheets(1)
Set rngRange = shtRange.UsedRange
rngRange.Copy rngDestn
Call AdjustPivotDataRange
With ThisWorkbook.Sheets("Stock")
.Columns("A").ColumnWidth = 33
.Columns("E").ColumnWidth = 33
.Columns("I").ColumnWidth = 33
.Columns("M").ColumnWidth = 33
.Columns("Q").ColumnWidth = 33
.Columns("U").ColumnWidth = 33
.Columns("B:C").ColumnWidth = 12
.Columns("F:G").ColumnWidth = 12
.Columns("J:K").ColumnWidth = 12
.Columns("N:O").ColumnWidth = 12
.Columns("R:S").ColumnWidth = 12
.Columns("V:W").ColumnWidth = 12
End With
With ThisWorkbook.Sheets("Sales")
.Columns("A").ColumnWidth = 33
.Columns("E").ColumnWidth = 33
.Columns("I").ColumnWidth = 33
.Columns("M").ColumnWidth = 33
.Columns("R").ColumnWidth = 33
.Columns("U").ColumnWidth = 33
.Columns("B:C").ColumnWidth = 12
.Columns("F:G").ColumnWidth = 12
.Columns("J:K").ColumnWidth = 12
.Columns("N:O").ColumnWidth = 12
.Columns("S:T").ColumnWidth = 12
.Columns("V:W").ColumnWidth = 12
.Columns("X").ColumnWidth = 33
.Columns("Y:AB").ColumnWidth = 7
.Columns("AD").ColumnWidth = 33
.Columns("AE:AH").ColumnWidth = 7
End With
With ThisWorkbook.Sheets("Availability")
.Columns("A").ColumnWidth = 10
.Columns("F").ColumnWidth = 10
.Columns("K").ColumnWidth = 10
.Columns("P").ColumnWidth = 10
.Columns("B").ColumnWidth = 24
.Columns("G").ColumnWidth = 24
.Columns("L").ColumnWidth = 24
.Columns("Q").ColumnWidth = 24
.Columns("C:D").ColumnWidth = 9
.Columns("H:I").ColumnWidth = 9
.Columns("M:N").ColumnWidth = 9
.Columns("R:S").ColumnWidth = 9
End With
wrkRange.Close False
ThisWorkbook.Save
End Sub
Sub AdjustPivotDataRange()
'Set Variables Equal to Data Sheet and Pivot Sheet
Set Data_sht = ThisWorkbook.Worksheets("Sheet1")
Set Pivot_sht_Stock = ThisWorkbook.Worksheets("Stock")
Set Pivot_sht_Sales = ThisWorkbook.Worksheets("Sales")
Set Pivot_sht_Avail = ThisWorkbook.Worksheets("Availability")
'Dynamically Retrieve Range Address of Data
Set StartPoint = Data_sht.Range("A1")
Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
NewRange = Data_sht.Name & "!" & _
DataRange.Address(ReferenceStyle:=xlR1C1)
For a = 1 To 3
Select Case a
Case Is = 1
Call Refresh_Stock
Case Is = 2
Call Refresh_Sales
Case Is = 3
Call Refresh_Availability
End Select
Next a
End Sub
Sub Refresh_Availability()
For b = 1 To 20
'Enter in Pivot Table Name
shtAvailPivotName = "PTA" & b
'Change Pivot Table Data Source Range Address
Pivot_sht_Avail.PivotTables(shtAvailPivotName).ChangePivotCache _
ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=NewRange)
'Ensure Pivot Table is Refreshed
Pivot_sht_Avail.PivotTables(shtAvailPivotName).RefreshTable
Next b
End Sub
Sub Food_Availability()
Application.ScreenUpdating = False
For a = 1 To 4
'copy the range as an image
Select Case a
Case Is = 1
Set StartCell = Sheets("Availability").Range("A5")
Set Rng = StartCell.CurrentRegion
'Call Sheets("Availability").Range(Rng.Address).CopyPicture(xlScreen, xlPicture)
Worksheets("Availability").Range(Rng.Address).CopyPicture xlScreen, xlPicture
Case Is = 2
Set StartCell = Sheets("Availability").Range("F5")
Set Rng = StartCell.CurrentRegion
'Call Sheets("Availability").Range(Rng.Address).CopyPicture(xlScreen, xlPicture)
Worksheets("Availability").Range(Rng.Address).CopyPicture xlScreen, xlPicture
Case Is = 3
Set StartCell = Sheets("Availability").Range("K5")
Set Rng = StartCell.CurrentRegion
'Call Sheets("Availability").Range(Rng.Address).CopyPicture(xlScreen, xlPicture)
Worksheets("Availability").Range(Rng.Address).CopyPicture xlScreen, xlPicture
Case Is = 4
Set StartCell = Sheets("Availability").Range("P5")
Set Rng = StartCell.CurrentRegion
'Call Sheets("Availability").Range(Rng.Address).CopyPicture(xlScreen, xlPicture)
Worksheets("Availability").Range(Rng.Address).CopyPicture xlScreen, xlPicture
End Select
'remove all previous shapes in sheet2
On Error Resume Next
intCount = Sheets("Pictures").Shapes.Count
For i = 1 To intCount
Sheets("Pictures").Shapes.Item(1).Delete
Next i
On Error GoTo 0
'create an empty chart in sheet2
Sheets("Pictures").Shapes.AddChart
'activate sheet2
Sheets("Pictures").Activate
'select the shape in sheet2
Sheets("Pictures").Shapes.Item(1).Select
Set objChart = ActiveChart
'paste the range into the chart
Sheets("Pictures").Shapes.Item(1).Line.Visible = msoFalse
Sheets("Pictures").Shapes.Item(1).Width = Range("A1:E12").Width
Sheets("Pictures").Shapes.Item(1).Height = Range("A1:E12").Height
objChart.Paste
'save the chart as a JPEG
Select Case a
Case Is = 1
objChart.Export ("P:\H925 Buying\Dashboard Reports\Pictures\Food - Top100.jpg")
Case Is = 2
objChart.Export ("P:\H925 Buying\Dashboard Reports\Pictures\Food - Essentials.jpg")
Case Is = 3
objChart.Export ("P:\H925 Buying\Dashboard Reports\Pictures\Food - Non Ess.jpg")
Case Is = 4
objChart.Export ("P:\H925 Buying\Dashboard Reports\Pictures\Food - Seasonal.jpg")
End Select
Next a
End Sub
16491
Some time ago you were gracious in helping me with some time based looping code. I have adapted this but have found that a certain workbook that opens and runs a macro during the loop causes the loop to fall over and not complete. I don't think it is to do with opening and closing workbooks as there are two more that open, run macros, and then close before the one that causes the loop to end.
I am baffled as to why this particular work book causes the issue.
Can you help and look over my code below and tell me where you think the issue is as to why the Time Loop is falling over.
Below is the Time Loop code. I have highlighted in Bold text the Call Routine that makes the Time Loop fall over. I have attached this workbook.
Option Explicit
Dim KeepRunning As Boolean
Dim BookRunning As Boolean
Sub ScheduleMacroStart()
Debug.Print "started running Emails -- " & Now
KeepRunning = True
Application.OnTime Date + TimeValue("08:35"), "allemailsandcompile"
End Sub
Sub ScheduleMacroEnd()
Debug.Print "stopped running Emails -- " & Now
KeepRunning = False
End Sub
Sub allemailsandcompile() ' checks to see if all the emails have been captured
Dim pdat As Date, Monday As String, pdat2 As Date, Count As Long
If Not KeepRunning Then Exit Sub '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Debug.Print "still running -- " & Now
Application.OnTime Now + TimeValue("00:01:00"), "allemailsandcompile"
pdat = Format(Now, "dd/mm/yyyy")
Monday = DateAdd("ww", -1, pdat - (Weekday(pdat, vbMonday) - 8))
If pdat = Monday Then pdat2 = Format(Now - 3, "dd/mm/yyyy") Else pdat2 = Format(Now - 1, "dd/mm/yyyy")
Count = 0
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(Monday, "dd.mm.yyyy") & " Automated Stock Ledger By Dept.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call stockledger
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Availability Measurement by SKU.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call SkuAvailability
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Availability Measurement by Store.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call storeavailability
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " SKU Range Daily Availability Summary.pdf", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call dailyrangesummary
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Essentials Overstock " & Format(pdat, "dd.mm.yyyy") & ".xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call awrreports
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Essentials at Risk " & Format(pdat, "dd.mm.yyyy") & ".xlsm", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call awrreports
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " SKU Range Daily Availability.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call skurangefullversion
Call Update_Availability
Call Demographics
Call Category_Split ''''''' THIS ROUTINE CAUSES THE LOOP TO FALL OVER
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Booking Detail Report.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call Bookings
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Supplier to DC Delivery Issues " & Format(pdat2, "ddmmyy") & ".xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call dcfaileddelivery
End If
If Not Dir("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " Slots Report.xlsx", vbDirectory) = vbNullString Then
Count = Count + 1
Else
Call Slots
End If
If Count = 10 Then
Call ScheduleMacroEnd
Else
End If
End Sub
Sub Category_Split()
Application.ScreenUpdating = False
Workbooks.Open ("P:\H925 Buying\Dashboard Reports\Category Splits.xlsm")
Application.ScreenUpdating = False
End Sub
And Below is the Code on the workbook that is run when the workbook opens. I could not attach this workbook as it would not upload for some reason.
Dim i As Integer
Dim intCount As Integer
Dim objPic As Shape
Dim objChart As Chart
Dim StartCell As Range
Dim Rng As Range
Sub Start()
Call Update
Call Food_Availability
ThisWorkbook.Close False
End Sub
Dim Data_sht As Worksheet '
Dim Pivot_sht_Stock As Worksheet
Dim Pivot_sht_Sales As Worksheet
Dim Pivot_sht_Avail As Worksheet
Dim StartPoint As Range
Dim DataRange As Range ''
Dim shtStockPivotName As String
Dim shtSalesPivotName As String
Dim shtAvailPivotName As String
Dim NewRange As String
Sub Update()
Dim wrkRange As Workbook, shtRange As Worksheet, shtDestn As Worksheet
Dim rngRange As Range, rngDestn As Range, pdat As Date
pdat = Format(Now, "dd/mm/yyyy")
Set shtDestn = ThisWorkbook.Sheets("Sheet1")
With shtDestn
.Cells.ClearContents
End With
Set rngDestn = shtDestn.Cells(1, 1)
Set wrkRange = Workbooks.Open("P:\H925 Buying\Dashboard Reports\" & Format(pdat, "dd.mm.yyyy") & " SKU Range Daily Availability.xlsx")
Set shtRange = wrkRange.Sheets(1)
Set rngRange = shtRange.UsedRange
rngRange.Copy rngDestn
Call AdjustPivotDataRange
With ThisWorkbook.Sheets("Stock")
.Columns("A").ColumnWidth = 33
.Columns("E").ColumnWidth = 33
.Columns("I").ColumnWidth = 33
.Columns("M").ColumnWidth = 33
.Columns("Q").ColumnWidth = 33
.Columns("U").ColumnWidth = 33
.Columns("B:C").ColumnWidth = 12
.Columns("F:G").ColumnWidth = 12
.Columns("J:K").ColumnWidth = 12
.Columns("N:O").ColumnWidth = 12
.Columns("R:S").ColumnWidth = 12
.Columns("V:W").ColumnWidth = 12
End With
With ThisWorkbook.Sheets("Sales")
.Columns("A").ColumnWidth = 33
.Columns("E").ColumnWidth = 33
.Columns("I").ColumnWidth = 33
.Columns("M").ColumnWidth = 33
.Columns("R").ColumnWidth = 33
.Columns("U").ColumnWidth = 33
.Columns("B:C").ColumnWidth = 12
.Columns("F:G").ColumnWidth = 12
.Columns("J:K").ColumnWidth = 12
.Columns("N:O").ColumnWidth = 12
.Columns("S:T").ColumnWidth = 12
.Columns("V:W").ColumnWidth = 12
.Columns("X").ColumnWidth = 33
.Columns("Y:AB").ColumnWidth = 7
.Columns("AD").ColumnWidth = 33
.Columns("AE:AH").ColumnWidth = 7
End With
With ThisWorkbook.Sheets("Availability")
.Columns("A").ColumnWidth = 10
.Columns("F").ColumnWidth = 10
.Columns("K").ColumnWidth = 10
.Columns("P").ColumnWidth = 10
.Columns("B").ColumnWidth = 24
.Columns("G").ColumnWidth = 24
.Columns("L").ColumnWidth = 24
.Columns("Q").ColumnWidth = 24
.Columns("C:D").ColumnWidth = 9
.Columns("H:I").ColumnWidth = 9
.Columns("M:N").ColumnWidth = 9
.Columns("R:S").ColumnWidth = 9
End With
wrkRange.Close False
ThisWorkbook.Save
End Sub
Sub AdjustPivotDataRange()
'Set Variables Equal to Data Sheet and Pivot Sheet
Set Data_sht = ThisWorkbook.Worksheets("Sheet1")
Set Pivot_sht_Stock = ThisWorkbook.Worksheets("Stock")
Set Pivot_sht_Sales = ThisWorkbook.Worksheets("Sales")
Set Pivot_sht_Avail = ThisWorkbook.Worksheets("Availability")
'Dynamically Retrieve Range Address of Data
Set StartPoint = Data_sht.Range("A1")
Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
NewRange = Data_sht.Name & "!" & _
DataRange.Address(ReferenceStyle:=xlR1C1)
For a = 1 To 3
Select Case a
Case Is = 1
Call Refresh_Stock
Case Is = 2
Call Refresh_Sales
Case Is = 3
Call Refresh_Availability
End Select
Next a
End Sub
Sub Refresh_Availability()
For b = 1 To 20
'Enter in Pivot Table Name
shtAvailPivotName = "PTA" & b
'Change Pivot Table Data Source Range Address
Pivot_sht_Avail.PivotTables(shtAvailPivotName).ChangePivotCache _
ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=NewRange)
'Ensure Pivot Table is Refreshed
Pivot_sht_Avail.PivotTables(shtAvailPivotName).RefreshTable
Next b
End Sub
Sub Food_Availability()
Application.ScreenUpdating = False
For a = 1 To 4
'copy the range as an image
Select Case a
Case Is = 1
Set StartCell = Sheets("Availability").Range("A5")
Set Rng = StartCell.CurrentRegion
'Call Sheets("Availability").Range(Rng.Address).CopyPicture(xlScreen, xlPicture)
Worksheets("Availability").Range(Rng.Address).CopyPicture xlScreen, xlPicture
Case Is = 2
Set StartCell = Sheets("Availability").Range("F5")
Set Rng = StartCell.CurrentRegion
'Call Sheets("Availability").Range(Rng.Address).CopyPicture(xlScreen, xlPicture)
Worksheets("Availability").Range(Rng.Address).CopyPicture xlScreen, xlPicture
Case Is = 3
Set StartCell = Sheets("Availability").Range("K5")
Set Rng = StartCell.CurrentRegion
'Call Sheets("Availability").Range(Rng.Address).CopyPicture(xlScreen, xlPicture)
Worksheets("Availability").Range(Rng.Address).CopyPicture xlScreen, xlPicture
Case Is = 4
Set StartCell = Sheets("Availability").Range("P5")
Set Rng = StartCell.CurrentRegion
'Call Sheets("Availability").Range(Rng.Address).CopyPicture(xlScreen, xlPicture)
Worksheets("Availability").Range(Rng.Address).CopyPicture xlScreen, xlPicture
End Select
'remove all previous shapes in sheet2
On Error Resume Next
intCount = Sheets("Pictures").Shapes.Count
For i = 1 To intCount
Sheets("Pictures").Shapes.Item(1).Delete
Next i
On Error GoTo 0
'create an empty chart in sheet2
Sheets("Pictures").Shapes.AddChart
'activate sheet2
Sheets("Pictures").Activate
'select the shape in sheet2
Sheets("Pictures").Shapes.Item(1).Select
Set objChart = ActiveChart
'paste the range into the chart
Sheets("Pictures").Shapes.Item(1).Line.Visible = msoFalse
Sheets("Pictures").Shapes.Item(1).Width = Range("A1:E12").Width
Sheets("Pictures").Shapes.Item(1).Height = Range("A1:E12").Height
objChart.Paste
'save the chart as a JPEG
Select Case a
Case Is = 1
objChart.Export ("P:\H925 Buying\Dashboard Reports\Pictures\Food - Top100.jpg")
Case Is = 2
objChart.Export ("P:\H925 Buying\Dashboard Reports\Pictures\Food - Essentials.jpg")
Case Is = 3
objChart.Export ("P:\H925 Buying\Dashboard Reports\Pictures\Food - Non Ess.jpg")
Case Is = 4
objChart.Export ("P:\H925 Buying\Dashboard Reports\Pictures\Food - Seasonal.jpg")
End Select
Next a
End Sub
16491