asked on

Charts in VBA script need to align per loop

Hi,

I have a for loop in VBA that creates charts and assigns them a width, height, left and top value:

Range("A" + CStr(dayEnd) + ":D" + CStr(dayStart)).Select
Range("A" + CStr(dayStart)).Activate

ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("'Test'!$A$" + CStr(dayEnd) + ":$D$" + CStr(dayStart))
ActiveChart.ChartType = xlStockOHLC
ActiveChart.HasAxis(xlCategory) = True
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
ActiveChart.Axes(xlCategory).ReversePlotOrder = True
Selection.MajorTickMark = xlCross
Selection.TickLabelPosition = xlNone
ActiveChart.PlotArea.Select
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 35
ActiveChart.ClearToMatchStyle

ActiveSheet.ChartObjects.Width = 600
ActiveSheet.ChartObjects.Height = 400
ActiveSheet.ChartObjects.Left = 1000
ActiveSheet.ChartObjects.Top = 10

Range("H" + CStr(dayEnd) + ":I" + CStr(dayStart)).Select
Range("H" + CStr(dayStart)).Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range("'Test'!$H$" + CStr(dayEnd) + ":$I$" + CStr(dayStart))
'ActiveChart.SetSourceData Source:=Range("'Test'!$H$97:$I$192")'
ActiveChart.ChartType = xlSurface
ActiveWindow.SmallScroll Down:=12
ActiveChart.HasAxis(xlCategory) = True
ActiveChart.Axes(xlCategory).Select
ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
ActiveChart.Axes(xlCategory).ReversePlotOrder = True
Selection.MajorTickMark = xlCross
Selection.TickLabelPosition = xlNone

ActiveSheet.ChartObjects.Width = 600
ActiveSheet.ChartObjects.Height = 400
ActiveSheet.ChartObjects.Left = 1000

This is not the full code, its missing the for loop but the question I have you will probably not need to see the rest of my code.

The problem is the charts are all stacked on top of each other because of the Top property in the ActiveSheet. If I remove the ActiveSheet.ChartObjects.Top = 10 the charts are all lined along the left as I want but the two charts that are created per loop are on top of each other. Basically the ActiveSheet.ChartObjects.Top = 10 refers to the top of the workbook and I need it to refer to the charts location on the screen(when it is first created and not yet moved) and go up from there.

Thanks,
waffe

Chris Bottomley

Have you tried noting the first charts top position and adding the required displacement i.e. height to a variable and then using that value for the second chart?

Chris

Sub tst()
Dim intTopChart As Integer
Range("A" + CStr(dayEnd) + ":D" + CStr("F10")).Select
    Range("A" + CStr("F10")).Activate
    
   
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Test'!$A$" + CStr(dayEnd) + ":$D$" + CStr(dayStart))
    ActiveChart.ChartType = xlStockOHLC
    ActiveChart.HasAxis(xlCategory) = True
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Selection.MajorTickMark = xlCross
    Selection.TickLabelPosition = xlNone
    ActiveChart.PlotArea.Select
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 35
    ActiveChart.ClearToMatchStyle
    
    ActiveSheet.ChartObjects.Width = 600
    ActiveSheet.ChartObjects.Height = 400
    ActiveSheet.ChartObjects.Left = 1000
    intTopChart = ActiveSheet.ChartObjects.Top + ActiveSheet.ChartObjects.Height

    Range("H" + CStr(dayEnd) + ":I" + CStr(dayStart)).Select
    Range("H" + CStr(dayStart)).Activate
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Test'!$H$" + CStr(dayEnd) + ":$I$" + CStr(dayStart))
    'ActiveChart.SetSourceData Source:=Range("'Test'!$H$97:$I$192")'
    ActiveChart.ChartType = xlSurface
    ActiveWindow.SmallScroll Down:=12
    ActiveChart.HasAxis(xlCategory) = True
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Selection.MajorTickMark = xlCross
    Selection.TickLabelPosition = xlNone
    
    ActiveSheet.ChartObjects.Width = 600
    ActiveSheet.ChartObjects.Height = 400
    ActiveSheet.ChartObjects.Left = 1000
    ActiveSheet.ChartObjects.Top = intTopChart

End Sub

Open in new window

waffe

ASKER

Thanks for the idea Chris but there seems to be another problem.

When I used your extra code the graphs ended up at the bottom of the last loop. This is what I have seen with other ideas but I was not sure why. Now with your code extra doing the same thing there must be a problem elsewhere.

here is a more complete view of my code:

For i = loopSize To 2 Step -1
    'set dayOpen for each new day'
        Cells(i, 7).Select
        If Selection.Value = "Start of Day" Then
            'get the rownumber of the selected start of day'
            RowNumberStart = Cells(i, 1).Row
            'find the end of the day row'
            Do
                Cells(RowNumberStart - Counter, 7).Select
                cellLoop = (RowNumberStart - Counter)
                Counter = Counter + 1
                RowNumberEnd = cellLoop + 1
            Loop Until Cells(cellLoop, 7).Value = "Start of Day"
            'Call Sub to create graphs...'
            createCSAndHighLowSpreadGraphs dayStart:=RowNumberStart, dayEnd:=RowNumberEnd
            Counter = 1
         End If
    Next

Open in new window

Sub createCSAndHighLowSpreadGraphs(dayStart As Integer, dayEnd As Integer)
'
' createCSAndHighLowSpread Macro
'
    Dim intTopChart
    Debug.Print "dayStart= " + CStr(dayStart)
    Debug.Print "dayEnd= " + CStr(dayEnd)
    
    Range("A" + CStr(dayEnd) + ":D" + CStr(dayStart)).Select
    Range("A" + CStr(dayStart)).Activate
    
   
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Test'!$A$" + CStr(dayEnd) + ":$D$" + CStr(dayStart))
    ActiveChart.ChartType = xlStockOHLC
    ActiveChart.HasAxis(xlCategory) = True
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Selection.MajorTickMark = xlCross
    Selection.TickLabelPosition = xlNone
    ActiveChart.PlotArea.Select
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 35
    ActiveChart.ClearToMatchStyle
    
    ActiveSheet.ChartObjects.Width = 600
    ActiveSheet.ChartObjects.Height = 400
    ActiveSheet.ChartObjects.Left = 1000
    intTopChart = ActiveSheet.ChartObjects.Top + ActiveSheet.ChartObjects.Height
    Debug.Print ActiveSheet.ChartObjects.Top
    Debug.Print ActiveSheet.ChartObjects.Height
    Debug.Print intTopChart
    
    Range("H" + CStr(dayEnd) + ":I" + CStr(dayStart)).Select
    Range("H" + CStr(dayStart)).Activate
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Test'!$H$" + CStr(dayEnd) + ":$I$" + CStr(dayStart))
    ActiveChart.ChartType = xlSurface
    ActiveWindow.SmallScroll Down:=12
    ActiveChart.HasAxis(xlCategory) = True
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Selection.MajorTickMark = xlCross
    Selection.TickLabelPosition = xlNone
    
    ActiveSheet.ChartObjects.Width = 600
    ActiveSheet.ChartObjects.Height = 400
    ActiveSheet.ChartObjects.Left = 1000
    ActiveSheet.ChartObjects.Top = intTopChart



End Sub

Open in new window

It's as if all the graphs are being moved at once instead of each graph being positioned per loop. I print intTopChart per loop at it looks good...

Chris Bottomley

Can you supply a test file of data?

Chris

waffe

ASKER

Sure, can you email me your email at xlncstudios@yahoo.com and I'll send you the data.

waffe

ASKER

On second thought... here is a data sample at yousendit
https://www.yousendit.com/download/T2pIc0x5SWUwZ252Wmc9PQ

Chris Bottomley

See as below ... hopefully that's it.

Chris

Range("A" + CStr(dayend) + ":D" + CStr(daystart)).Select
    Range("A" + CStr(daystart)).Activate
   
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Test'!$A$" + CStr(dayend) + ":$D$" + CStr(daystart))
    ActiveChart.ChartType = xlStockOHLC
    ActiveChart.HasAxis(xlCategory) = True
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Selection.MajorTickMark = xlCross
    Selection.TickLabelPosition = xlNone
    ActiveChart.PlotArea.Select
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 35
    ActiveChart.ClearToMatchStyle
    
    ActiveChart.ChartArea.Width = 600
    ActiveChart.ChartArea.Height = 400
    ActiveChart.ChartArea.Left = 1000
    ActiveChart.ChartArea.Top = 10

    Range("H" + CStr(dayend) + ":I" + CStr(daystart)).Select
    Range("H" + CStr(daystart)).Activate
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Test'!$H$" + CStr(dayend) + ":$I$" + CStr(daystart))
    'ActiveChart.SetSourceData Source:=Range("'Test'!$H$97:$I$192")'
    ActiveChart.ChartType = xlSurface
    ActiveWindow.SmallScroll Down:=12
    ActiveChart.HasAxis(xlCategory) = True
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Selection.MajorTickMark = xlCross
    Selection.TickLabelPosition = xlNone
    ActiveChart.ChartArea.Top = 420
    ActiveChart.ChartArea.Width = 600
    ActiveChart.ChartArea.Height = 400
    ActiveChart.ChartArea.Left = 1000

Open in new window

waffe

ASKER

Kind of, but if you set the loop to 200 you will produce 4 graphs (2 for each loop) and all of them are at the top in two groups, one above the other. The one above the other is correct but not for all four graphs. The next two should be below at the next "start of day" maker in the G column.

Every place there is a "Start of Day" there should be two graphs to the right. This works if you remove the Top parameter but then the two graphs per loop are on top of each other. What a crazy problem! Would be nice If I could tell each graph to go to a specific cell. Is there such a way?

Chris Bottomley

Basically it is .. as below you take the cells in a loop where they have the string and take the top value for that cell. YOu can of course offset a bit in each case ... i.e. 10.

Chris

Dim rng As Range
Dim rngStarter As String

    Set rng = ActiveSheet.Cells(ActiveSheet.Rows.Count, 7)
    Do While rngStarter <> rng.Address
        If rngStarter = "" Then rngStarter = rng.Address
        Set rng = Columns("G:G").Find(What:="Start of Day", After:=rng, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False)
        Debug.Print rng.Address
        Debug.Print rng.Top
    Loop

Open in new window

waffe

ASKER

Chris I'm a little lost with that last bit of code. Can you show me how to implement it into my code?

waffe

ASKER

When I replace my "do loop" with yours it runs and prints but then it falls into an infinite loop. Any clue why?

Chris Bottomley

Can you upload your code ... I suspect the stop condition ... I tend to use a stop control I find that loops do sometimes fail in some versions so tend to be anal with range checks in excel.

Chris

waffe

ASKER

Here is a link to code

https://www.yousendit.com/download/T2pHQmtkdEM1R05FQlE9PQ

I turned off a chunk of my code still trying to figure out what yours does exactly; regardless, it seem to still fall into an endless loop.

Thanks for looking into it!

Chris Bottomley

IN your loops ... how is daystart dayend calculated?

Chris

Chris Bottomley

Also can you advise your original loop ... i.e. before anything from me

Chris

Chris Bottomley

CRB1 has been implemented with some changes to control the loop using my earlier chart code and delcharts to delete the charts in one throw for testing.

Chris testData2-.xlsm

Sub crb1()
Dim LookAtRange As Range
Dim rng As Range
Dim rngStarter As Integer
Dim bolStopMe As Boolean
Dim daystart As Long
Dim dayend As Long
Dim lngTop As Long

    Set LookAtRange = ActiveSheet.Range("A1:J" & ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row - 1)
    Set LookAtRange = Intersect(LookAtRange, Columns("G:G"))
    Set rng = ActiveSheet.Cells(LookAtRange.Rows.Count, 7)
    Set rng = LookAtRange.Find(What:="Start of Day", After:=rng, LookIn:= _
    xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=False)
    bolStopMe = rng Is Nothing
    Do While Not bolStopMe
        Set rng = LookAtRange.Find(What:="Start of Day", After:=rng, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False)
        bolStopMe = rng.Row <= rngStarter
        rngStarter = rng.Row
        daystart = rng.Row
        dayend = rng.Row + 100
    Application.StatusBar = "Processing from row " & rng.Row
    Range("A" + CStr(dayend) + ":D" + CStr(daystart)).Select
    Range("A" + CStr(daystart)).Activate
    lngTop = rng.Top
   
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Test'!$A$" + CStr(dayend) + ":$D$" + CStr(daystart))
    ActiveChart.ChartType = xlStockOHLC
    ActiveChart.HasAxis(xlCategory) = True
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Selection.MajorTickMark = xlCross
    Selection.TickLabelPosition = xlNone
    ActiveChart.PlotArea.Select
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 35
    ActiveChart.ClearToMatchStyle
    
    ActiveChart.ChartArea.Width = 600
    ActiveChart.ChartArea.Height = 400
    ActiveChart.ChartArea.Left = 1000
    ActiveChart.ChartArea.Top = lngTop + 10

    Range("H" + CStr(dayend) + ":I" + CStr(daystart)).Select
    Range("H" + CStr(daystart)).Activate
    With ActiveSheet.Shapes.AddChart
        .Select
        .Chart.SetSourceData Source:=Range("'Test'!$H$" + CStr(dayend) + ":$I$" + CStr(daystart))
        .Chart.ChartType = xlSurface
        .Chart.HasAxis(xlCategory) = True
        .Chart.Axes(xlCategory).Select
        .Chart.Axes(xlCategory).TickMarkSpacing = 25
        .Chart.Axes(xlCategory).ReversePlotOrder = True
        Selection.MajorTickMark = xlCross
        Selection.TickLabelPosition = xlNone
        .Chart.ChartArea.Top = lngTop + 420
        .Chart.ChartArea.Width = 600
        .Chart.ChartArea.Height = 400
        .Chart.ChartArea.Left = 1000
    End With
    Loop
    Application.StatusBar = False
    MsgBox "Completed!"
End Sub

Sub delCharts()
Dim ch As Integer

    For ch = ActiveSheet.Shapes.Count To 1 Step -1
        If ActiveSheet.Shapes(ch).HasChart Then ActiveSheet.Shapes(ch).Delete
    Next
End Sub

Open in new window

Chris Bottomley

I have hacked the code to add a calculation for daysend as the row before the next start day ... I presume that was the basic intent.

Chris

Sub crb1()
Dim LookAtRange As Range
Dim LookAtRange2 As Range
Dim rng As Range
Dim rng2 As Range
Dim rngStarter As Integer
Dim bolStopMe As Boolean
Dim daystart As Long
Dim dayend As Long
Dim lngTop As Long

    Set LookAtRange = ActiveSheet.Range("A1:J" & ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row - 1)
    Set LookAtRange = Intersect(LookAtRange, Columns("G:G"))
    Set LookAtRange2 = LookAtRange.Resize(LookAtRange.Rows.Count + 1, 1)
    Set rng = ActiveSheet.Cells(LookAtRange.Rows.Count, 7)
    Set rng = LookAtRange.Find(What:="Start of Day", After:=rng, LookIn:= _
    xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=False)
    Set rng2 = LookAtRange2.Find(What:="Start of Day", After:=rng, LookIn:= _
    xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=False)
    bolStopMe = rng Is Nothing
    Do While Not bolStopMe
        bolStopMe = rng.Row <= rngStarter
        rngStarter = rng.Row
        daystart = rng.Row
        dayend = rng2.Row - 1
    Application.StatusBar = "Processing from row " & rng.Row
    Range("A" + CStr(dayend) + ":D" + CStr(daystart)).Select
    Range("A" + CStr(daystart)).Activate
    lngTop = rng.Top
   
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Test'!$A$" + CStr(dayend) + ":$D$" + CStr(daystart))
    ActiveChart.ChartType = xlStockOHLC
    ActiveChart.HasAxis(xlCategory) = True
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Selection.MajorTickMark = xlCross
    Selection.TickLabelPosition = xlNone
    ActiveChart.PlotArea.Select
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 35
    ActiveChart.ClearToMatchStyle
    
    ActiveChart.ChartArea.Width = 600
    ActiveChart.ChartArea.Height = 400
    ActiveChart.ChartArea.Left = 1000
    ActiveChart.ChartArea.Top = lngTop + 10

        Range("H" + CStr(dayend) + ":I" + CStr(daystart)).Select
        Range("H" + CStr(daystart)).Activate
        With ActiveSheet.Shapes.AddChart
            .Select
            .Chart.SetSourceData Source:=Range("'Test'!$H$" + CStr(dayend) + ":$I$" + CStr(daystart))
            .Chart.ChartType = xlSurface
            .Chart.HasAxis(xlCategory) = True
            .Chart.Axes(xlCategory).Select
            .Chart.Axes(xlCategory).TickMarkSpacing = 25
            .Chart.Axes(xlCategory).ReversePlotOrder = True
            Selection.MajorTickMark = xlCross
            Selection.TickLabelPosition = xlNone
            .Chart.ChartArea.Top = lngTop + 420
            .Chart.ChartArea.Width = 600
            .Chart.ChartArea.Height = 400
            .Chart.ChartArea.Left = 1000
        End With
        Set rng = LookAtRange.Find(What:="Start of Day", After:=rng, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False)
        Set rng2 = LookAtRange2.Find(What:="Start of Day", After:=rng, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False)
    Loop
    Application.StatusBar = False
    MsgBox "Completed!"
End Sub

Sub delCharts()
Dim ch As Integer

    For ch = ActiveSheet.Shapes.Count To 1 Step -1
        If ActiveSheet.Shapes(ch).HasChart Then ActiveSheet.Shapes(ch).Delete
    Next
End Sub

Open in new window

waffe

ASKER

Yah! you took garbage(my code) and turned it into art(your code)! - lol! Thx!

The dayStart is calculated by look at the date column and finding hour 17:00:00 which is the closing and reopening of the market. I removed the code trying to clean up my code a little before I gave it to you. I should of left it in ...

But I don't want to take too much of your time so I'll do that calculating with my old code and try to learn your code to implement my loops better.

There is one small problem that you could update easily. The graph data starts and ends in the wrong spot. From the "Start of Day" marker the sequence of minutes moves up and stops 1 row before the next "Start of Day" marker. Currently the selected data starts at a "Start of Day" marker and moves down and stops 1 row before the next "Start of Day" marker.

Also, you added a new calculation but I don't see what it is. What is it?

"[...]daysend as the row before the next start day"
The concept of the second graph is the distance of high/low above or below the starting point of the day. When the graph is pinched the high/low is crossing the day starting point and when the graph is fat the high/low distance from the day start is large.

Thanks again Chris!
waffe

Chris Bottomley

If I get your drift then I have daystart and dayend the wrong way around so all i've done here is swap those definitions around ... does it look better now?

Chris

Sub crb1()
Dim LookAtRange As Range
Dim LookAtRange2 As Range
Dim rng As Range
Dim rng2 As Range
Dim rngStarter As Integer
Dim bolStopMe As Boolean
Dim daystart As Long
Dim dayend As Long
Dim lngTop As Long

    Set LookAtRange = ActiveSheet.Range("A1:J" & ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row - 1)
    Set LookAtRange = Intersect(LookAtRange, Columns("G:G"))
    Set LookAtRange2 = LookAtRange.Resize(LookAtRange.Rows.Count + 1, 1)
    Set rng = ActiveSheet.Cells(LookAtRange.Rows.Count, 7)
    Set rng = LookAtRange.Find(What:="Start of Day", After:=rng, LookIn:= _
    xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=False)
    Set rng2 = LookAtRange2.Find(What:="Start of Day", After:=rng, LookIn:= _
    xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=False)
    bolStopMe = rng Is Nothing
    Do While Not bolStopMe
        bolStopMe = rng.Row <= rngStarter
        rngStarter = rng.Row
        dayend = rng.Row
        daystart = rng2.Row - 1
    Application.StatusBar = "Processing from row " & rng.Row
    Range("A" + CStr(dayend) + ":D" + CStr(daystart)).Select
    Range("A" + CStr(daystart)).Activate
    lngTop = rng.Top
   
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'Test'!$A$" + CStr(dayend) + ":$D$" + CStr(daystart))
    ActiveChart.ChartType = xlStockOHLC
    ActiveChart.HasAxis(xlCategory) = True
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.Axes(xlCategory).TickMarkSpacing = 25
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Selection.MajorTickMark = xlCross
    Selection.TickLabelPosition = xlNone
    ActiveChart.PlotArea.Select
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 35
    ActiveChart.ClearToMatchStyle
    
    ActiveChart.ChartArea.Width = 600
    ActiveChart.ChartArea.Height = 400
    ActiveChart.ChartArea.Left = 1000
    ActiveChart.ChartArea.Top = lngTop + 10

        Range("H" + CStr(dayend) + ":I" + CStr(daystart)).Select
        Range("H" + CStr(daystart)).Activate
        With ActiveSheet.Shapes.AddChart
            .Select
            .Chart.SetSourceData Source:=Range("'Test'!$H$" + CStr(dayend) + ":$I$" + CStr(daystart))
            .Chart.ChartType = xlSurface
            .Chart.HasAxis(xlCategory) = True
            .Chart.Axes(xlCategory).Select
            .Chart.Axes(xlCategory).TickMarkSpacing = 25
            .Chart.Axes(xlCategory).ReversePlotOrder = True
            Selection.MajorTickMark = xlCross
            Selection.TickLabelPosition = xlNone
            .Chart.ChartArea.Top = lngTop + 420
            .Chart.ChartArea.Width = 600
            .Chart.ChartArea.Height = 400
            .Chart.ChartArea.Left = 1000
        End With
        Set rng = LookAtRange.Find(What:="Start of Day", After:=rng, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False)
        Set rng2 = LookAtRange2.Find(What:="Start of Day", After:=rng, LookIn:= _
        xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False)
    Loop
    Application.StatusBar = False
    MsgBox "Completed!"
End Sub

Sub delCharts()
Dim ch As Integer

    For ch = ActiveSheet.Shapes.Count To 1 Step -1
        If ActiveSheet.Shapes(ch).HasChart Then ActiveSheet.Shapes(ch).Delete
    Next
End Sub

Open in new window

waffe

ASKER

Here is a screen shot of how the data should be selected.
dataSelection.png

ASKER CERTIFIED SOLUTION

Chris Bottomley

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

waffe

ASKER

Thanks again!

Chris Bottomley

Didn't take long ... ;o)

Glad to help, happier still to get it resolved.

Chris