Solved

Charts in VBA script need to align per loop

Posted on 2011-02-22
22
693 Views
Last Modified: 2012-05-11
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
0
Comment
Question by:waffe
  • 12
  • 10
22 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34958771
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

0
 

Author Comment

by:waffe
ID: 34962725
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...  

 
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34962764
Can you supply a test file of data?

Chris
0
 

Author Comment

by:waffe
ID: 34963356
Sure, can you email me your email at xlncstudios@yahoo.com and I'll send you the data.
0
 

Author Comment

by:waffe
ID: 34963419
On second thought... here is a data sample at yousendit
https://www.yousendit.com/download/T2pIc0x5SWUwZ252Wmc9PQ
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34964175
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

0
 

Author Comment

by:waffe
ID: 34964375
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?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34964704
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

0
 

Author Comment

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

Author Comment

by:waffe
ID: 34965849
When I replace my "do loop" with yours it runs and prints but then it falls into an infinite loop. Any clue why?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34967461
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
0
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 

Author Comment

by:waffe
ID: 34967713
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!
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34967854
IN your loops ... how is daystart dayend calculated?

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34967875
Also can you advise your original loop ... i.e. before anything from me


Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34968160
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

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34968495
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

0
 

Author Comment

by:waffe
ID: 34973373
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
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34973508
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

0
 

Author Comment

by:waffe
ID: 34973695
Here is a screen shot of how the data should be selected.
dataSelection.png
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 34973907
Okay then another small tweak

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 + 1
        daystart = rng2.Row
    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

Open in new window

0
 

Author Closing Comment

by:waffe
ID: 34974312
Thanks again!
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34974422
Didn't take long ... ;o)

Glad to help, happier still to get it resolved.

Chris
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now