Problem running multiple macros in one go

Michaelpfreem · Sep 2, 2010

Dear all,

I am having a problem I have written several smaller macros that provide steps I need in order to complete the function I am trying to do. I am trying to import some data, sort out a graph, sort the data then export the graph as a picture.

When I run each macro one at a time in steps they do exactly what I need them to. I can import tha data, I can sort the graph out to look at the new data tab (Rheotune), I can sort the data on the new tab and i can then export the graph once that is complete.

The problem is I try to put the macros together and it works all the way through except the graph that is exported has nothing on it, it will make the file but with nothing in it. Ultimately what i want to be able to do is have the macro open multiple files and produce a graph for each file that is opened, but currently I can't get it to work for one file does anyone have any ideas where I might be going wrong (see code below, I hope).

Any and all ideas much appreciated.

Many thanks in advance,
Mike

Sub Import() Dim FileList As Variant Dim MyFileName As String Dim FileCount As Integer Dim FileNum As Integer Dim Wb As Workbook Dim strSheetName As String Call Delete ChDir "C:\" FileList = Application.GetOpenFilename(, , , , True) On Error Resume Next FileCount = UBound(FileList) On Error GoTo 0 If Err.Number = 0 Then For FileNum = 1 To FileCount MyFileName = FileList(FileNum) Application.ScreenUpdating = False Workbooks.OpenText Filename:=MyFileName, Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True ActiveSheet.Select ActiveSheet.Copy Before:=ThisWorkbook.Sheets(1) strSheetName = ActiveSheet.Name Sheets("Instructions").Range("B10").Value = strSheetName ActiveSheet.Name = "RheoTune" For Each Wb In Workbooks If Wb.Name <> "Excel2KMLRheo.xlsm" Then Wb.Close savechanges:=False End If Next Wb Application.StatusBar = "All Workbooks Closed." Call GraphSetup Call SortData Call Delete Next End If 'Sheets("Control").Select End Sub Sub ExportChart() ' Export a selected chart as a picture Const sSlash$ = "/" Const sPicType$ = ".gif" Dim sChartName$ Dim sPath$ Dim sBook$ Dim chtObj As ChartObject Dim cht As Chart Application.DisplayAlerts = False Sheets("Graph").Select ActiveSheet.Calculate On Error Resume Next Range("A1").Select Selection.ClearContents With Range("B2:M57") .CopyPicture Appearance:=xlScreen, Format:=xlBitmap 'size to range plus a bit for chart border Set chtObj = ActiveSheet.ChartObjects.Add( _ .Left, .Top, .Width, .Height) End With ' If a name was given, chart is exported as a picture in the same ' folder location as their current file chtObj.Chart.Paste sBook = ActiveWorkbook.Path sChartName = Sheets("Instructions").Range("B10") sPath = sBook & sSlash & sChartName & sPicType chtObj.Chart.Export Filename:=sPath, FilterName:="GIF" chtObj.Delete Application.DisplayAlerts = True End Sub Sub GraphSetup() Sheets("Graph").Select Range("C51").Select ActiveCell.FormulaR1C1 = "=RheoTune!R[-46]C[-1]" Range("C52").Select ActiveCell.FormulaR1C1 = "=""Max.Depth: ""&RheoTune!R[-36]C[1]:R[2094]C[1]" Range("C53").Select ActiveCell.FormulaR1C1 = "=""DensiTune- ""&RheoTune!R[-42]C" Range("C54").Select ActiveCell.FormulaR1C1 = _ "=RheoTune!R[-42]C[-1]&"" ""&RheoTune!R[-42]C&"" ""&RheoTune!R[-42]C[1]" Range("C55").Select ActiveCell.FormulaR1C1 = "=RheoTune!R[-42]C[-1]&"" ""&RheoTune!R[-42]C" Range("C56").Select ActiveCell.FormulaR1C1 = _ "=RheoTune!R[-42]C[-1]&"" ""&RheoTune!R[-42]C&"" ""&RheoTune!R[-42]C[1]&"" ""&RheoTune!R[-42]C[2]" Range("I52").Select ActiveCell.FormulaR1C1 = _ "=""Location: ""&RheoTune!R[-44]C[-7]&"" X, ""&RheoTune!R[-44]C[-6]&"" Y""" Range("I53").Select ActiveCell.FormulaR1C1 = "=""Kp: 0.00m""" Range("I54").Select ActiveCell.FormulaR1C1 = _ "=""Date: ""&TEXT(RheoTune!R[-50]C[-7],""dd/mm/yyyy"")" Range("I55").Select ActiveCell.FormulaR1C1 = "=""Time: ""&TEXT(RheoTune!R[-51]C[-6],""hh:mm:ss"")" Range("I56").Select ActiveCell.FormulaR1C1 = "=""Tide: ""&RheoTune!R[-47]C[-7]&"" m""" ActiveSheet.ChartObjects("Chart 1").Activate ActiveChart.PlotArea.Select ActiveChart.SeriesCollection(1).XValues = "=RheoTune!$E$16:$E$10000" ActiveChart.SeriesCollection(1).Values = "=RheoTune!$D$16:$D$10000" Range("A1").Select End Sub Sub Delete() Dim sh As Worksheet Application.DisplayAlerts = False Sheets("Control").Select For Each sh In Sheets If sh.Name = "RheoTune" Then sh.Delete End If Next Application.DisplayAlerts = True End Sub Sub SortData() Sheets("RheoTune").Select Range("A16").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.AutoFilter ActiveSheet.Range("$A$16:$P$16").AutoFilter Field:=1, Criteria1:="DAT" Range("A16").Select Call ExportChart Sheets("RheoTune").Select Selection.AutoFilter End Sub

texasalynn · Sep 2, 2010

Have you tried stepping thru the macro? I find my mistakes many times by doing that. Sometimes when you do the macros independently you have your start place differently than when you run the combined macros. HTH

Michaelpfreem · Sep 5, 2010

Yep I tried that, when I run through each one individually from start to finish it works with no problems, but when I try to run them all in one go it fails. I am assuming it is something to do with updating the graph dureing a marco but I thought I had included that in the macro. Obviously not though.

Thanks,
Mike

bgs123 · Sep 5, 2010

if each macro works one at a time , you could try and create a quick VBA to run each macro one at a time.

Sub Run_All ()

Application.Run "Macro1"
Application.Run "Macro2"

End Sub

Just need to add them to run in the order you need.

Michaelpfreem · Sep 6, 2010

I tried that but still it just copies a blank graph, so something is still not updating the graph during the course of the macro.

I also need the macros to run inside the import macro, as I want to open multiple files and have them all run the macros.

Thanks,
Mike

Michaelpfreem · Sep 6, 2010

To make things a little more confusing I have been going through each macro running them all and then taking one at a time out of the loop to see what causes the problem.

It turns out that when I include the import macro in the loop that is what casues the export macro to export nothing. Inlcuding the others has no affect.

Has anyone got any idea why the import section would cause the export macro to export a blank graph?

I should point out during the tests I asked the export macro to export a section of an exisiting sheet as I wasn't running the import macro and so there would be no Rheotune sheet to copy from.

Thanks,
Mike

texasalynn · Sep 6, 2010

What if you put a pause into your macro for that section to give the calculations time to run?

Michaelpfreem · Sep 7, 2010

Hello all,

Thanks for the help I tried the pause and that failed as well, I have now tracked the issue down, it is one of those embarrassing mistakes you wished you'd noticed before you posted the problem on the internet.

The issue is in the import sub and the issue is:

Application.ScreenUpdating = False

This would appare to stop the graphs updating when it comes to copying. I turned this line off and it all works fine now.

Sorry to have wasted peoples time but thanks for the suggestions.

Thanks,
Mike

Problem running multiple macros in one go

Michaelpfreem

Board Regular

Excel Facts

texasalynn

Well-known Member

Michaelpfreem

Board Regular

bgs123

New Member

Michaelpfreem

Board Regular

Michaelpfreem

Board Regular

texasalynn

Well-known Member

Michaelpfreem

Board Regular

Similar threads

Forum statistics

Share this page

Problem running multiple macros in one go

Board Regular

Excel Facts

Well-known Member

Board Regular

New Member

Board Regular

Board Regular

Well-known Member

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock