Charts

[InnaG]

Hello,
I hope my request is possible. I need to create a code to go through the data on a spreadsheet and create chart for each product block. There are might be multiple product blocks. I got code to create the first one, but I am pretty bad with loops and have no idea how to make it go through the sheet and create one chart per block of data. Each block has one row identical and it is a header row - the first cell "In Stock?" I need to use information from columns A & B. Below is a code I have for the first block of data:

Sub chart1()
Dim myWorksheet As Worksheet
Dim mySourceData As Range
Dim myChart As Chart
Dim myChartDestination As Range


'identify worksheet containing source data and created bar chart


Set myWorksheet = ThisWorkbook.Worksheets("Overall Summary")
With myWorksheet


'identify source data
Set mySourceData = .Range("A6:B9")
'identify chart location
Set myChartDestination = .Range("J2:N10")
'create bar chart
Set myChart = .Shapes.AddChart(XlChartType:=xlWaterfall, Left:=myChartDestination.Cells(1).Left, Top:=myChartDestination.Cells(1).Top, Width:=myChartDestination.Width, Height:=myChartDestination.Height).Chart
End With
'set source data for created bar chart


myChart.SetSourceData Source:=mySourceData


End Sub

Thanks,
Inna

 

[DanteAmor]

Try this

Sub chart1()
    Dim sh As Worksheet
    Dim mySourceData As Range, myChartD As Range
    Dim myChart As Chart
    Dim r As Range, b As Range, wCell As String
    Dim lr As Long
    Const sText = "In Stock"
    
    Set sh = ThisWorkbook.Worksheets("Overall Summary")
    lr = sh.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    sh.Cells(lr, "A").Value = sText
    
    Set r = sh.Columns("A")
    Set b = r.Find(sText, LookAt:=xlWhole, LookIn:=xlValues)
    If Not b Is Nothing Then
        wCell = b.Address
        Do
            'detalle
            If b.Row = lr Then Exit Do
            For i = b.Row + 1 To lr
                If sh.Cells(i, "A").Value = sText Then
                    'fin = i - 1
                    'identify source data
                    Set mySourceData = sh.Range("A" & b.Row & ":B" & i - 1)
                    'identify chart location
                    Set myChartD = sh.Range("J" & b.Row & ":N" & i - 1)
                    'create bar chart
                    Set myChart = sh.Shapes.AddChart(XlChartType:=xlWaterfall, _
                        Left:=myChartD.Cells(1).Left, _
                        Top:=myChartD.Cells(1).Top, _
                        Width:=myChartD.Width, _
                        Height:=myChartD.Height).Chart
                    myChart.SetSourceData Source:=mySourceData
                    Exit For
                End If
            Next
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> wCell
    End If
    sh.Cells(lr, "A").Value = ""


    MsgBox "Done"


End Sub

 

[InnaG]

Thank you so much!!! It works. I have a question, is there are way to limit chart fields to cells that have "YES", "NO" & "Excluded Records"? If not I can work around it.
Thank you again!!!

 

[DanteAmor]

Can you explain it with examples, how are your data on the sheet and what do you expect as a result?

 

[InnaG]

Each block of information has:

Title

Product
Option

then a table that has following headers:
In Network? Total Records % of Total Records
YES 15 90.00%
NO 5 5.00%
Excluded 5
Total Records in File 25


There are might be anywhere from one to 15 blocks like that on the "Overall Summary tab. Your code creates charts and works great, but I need charts only to include In Network column and Total Records Column and "YES", "NO" and "Excluded" rows.

Thanks,
Inna

 

[DanteAmor]

You would have to explain it with images, or upload a file.

You could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

It also records a macro in the way you do it manually and post here.