Create chart in new book

[mari_hitz]

Hi guys!

I have a question. I would like to create a new excel workbook based on the information that I have in another workbook. I have created the code which asks to provide the range where the information is and then creates the new workbook, copies the information selected and creates a chart based on that information.
The code does not returns me an error, however it creates the wokbook without the information. I am posting my code, do you have any toughts how can I make this work?

Private Sub CommandButton1_Click()
  Dim oRangeSelected As Range
    On Error Resume Next
    Set oRangeSelected = Application.InputBox("Please select a range of cells!", _
                                              "SelectARAnge Demo", Selection.Address, , , , , 8)
                                            
  Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(1)
Set objRange = objWorksheet.UsedRange
objRange.Select

Set colCharts = objExcel.Charts
colCharts.Add

Set objChart = colCharts(1)
objChart.Activate

objChart.ChartType = 65

objChart.PlotArea.Fill.PresetGradient 1, 1, 7

objChart.SeriesCollection(1).Border.Weight = -4138
objChart.SeriesCollection(2).Border.Weight = -4138
objChart.SeriesCollection(3).Border.Weight = -4138

objChart.SeriesCollection(1).Border.ColorIndex = 2
objChart.SeriesCollection(1).MarkerBackgroundColorIndex = 2

objChart.SeriesCollection(2).MarkerForegroundColorIndex = 1
objChart.SeriesCollection(3).MarkerForegroundColorIndex = 1

objChart.HasTitle = True
objChart.ChartTitle.Text = ""
objChart.ChartTitle.Font.Size = 18

objChart.ChartArea.Fill.Visible = True
objChart.ChartArea.Fill.PresetTextured 15

objChart.ChartArea.Border.LineStyle = 1

objChart.HasLegend = True
objChart.Legend.Shadow = True

    If oRangeSelected Is Nothing Then
        MsgBox "It appears as if you pressed cancel!"
    Else
        MsgBox "You selected: " & oRangeSelected.Address(External:=True)
    End If
End Sub

 

[Ralajer]

The above code doesn't copy the range after it is selected to the new workbook. Also you won't get any runtime error because you are using On Error Resume Next.
The below code will copy the data values over. I also made few changes too, like moving the selected range to the top so if nothing is selected it will exit the sub.

Try this out.

Private Sub CommandButton1_Click()
    Dim oRangeSelected As Range
    
    Dim objExcel As Object
    Dim objWorkbook As Workbook
    Dim objWorksheet As Worksheet
    Dim objRange As Range

    Dim objChart As Chart

    
    Set oRangeSelected = Application.InputBox("Please select a range of cells!", _
                                              "SelectARAnge Demo", Selection.Address, , , , , 8)
    If oRangeSelected Is Nothing Then
        MsgBox "It appears as if you pressed cancel!"
        Exit Sub
    Else
        MsgBox "You selected: " & oRangeSelected.Address(External:=True)
    End If
                                                                            
    Set objExcel = CreateObject("Excel.Application")
    
    objExcel.Visible = True
    
    Set objWorkbook = objExcel.Workbooks.Add()
    Set objWorksheet = objWorkbook.Worksheets(1)

    oRangeSelected.Copy
    objWorksheet.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
    
    Set objRange = objWorksheet.UsedRange
    
    objRange.Select

    Set objChart = objExcel.Charts.Add
    
    With objChart
        .Activate
        
        .ChartType = 65
        
        .PlotArea.Fill.PresetGradient 1, 1, 7
        
        .SeriesCollection(1).Border.Weight = -4138
        .SeriesCollection(2).Border.Weight = -4138
        .SeriesCollection(3).Border.Weight = -4138
        
        .SeriesCollection(1).Border.ColorIndex = 2
        .SeriesCollection(1).MarkerBackgroundColorIndex = 2
        
        .SeriesCollection(2).MarkerForegroundColorIndex = 1
        .SeriesCollection(3).MarkerForegroundColorIndex = 1
        
        .HasTitle = True
        .ChartTitle.Text = ""
        .ChartTitle.Font.Size = 18
        
        .ChartArea.Fill.Visible = True
        .ChartArea.Fill.PresetTextured 15
        
        .ChartArea.Border.LineStyle = 1
        
        .HasLegend = True
        .Legend.Shadow = True
    End With '// objChart
End Sub

 

[mari_hitz]

Thanks a lot for your help! The code works just fine. I have one las question.
When I click on the cancel button of the pop up to select the range, it gives me error. (It shows the pop up which says Debug). I have checked the code and apparently there is nothing that indicates what to do if you click on cancel. How can I do this?

An another question: I have copied de the code and changed the chart type to appear as column, the code works, only that it returns the debug error. Do you know why this is happening?

Thanks!

 

[Ralajer]

The error pop-up where you pressed cancel is not part of the code it is part of vba letting you know that something in the code is wrong. The code looks to have been created for a particular data set if the data set selected doesn't match that it may throw an error. My guess is that it has something to do with the number of series. Try the below and if you get an error popup post the error's code #, name and description and what line of code is highlighted when the error occurs.

Private Sub CommandButton1_Click()
    Dim oRangeSelected As Range
    
    Dim objExcel As Object
    Dim objWorkbook As Workbook
    Dim objWorksheet As Worksheet
    Dim objRange As Range

    Dim objChart As Chart

    
    Set oRangeSelected = Application.InputBox("Please select a range of cells!", _
                                              "SelectARAnge Demo", Selection.Address, , , , , 8)
    If oRangeSelected Is Nothing Then
        MsgBox "It appears as if you pressed cancel!"
        Exit Sub
    Else
        MsgBox "You selected: " & oRangeSelected.Address(External:=True)
    End If
                                                                            
    Set objExcel = CreateObject("Excel.Application")
    
    objExcel.Visible = True
    
    Set objWorkbook = objExcel.Workbooks.Add()
    Set objWorksheet = objWorkbook.Worksheets(1)

    oRangeSelected.Copy
    objWorksheet.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
    
    Set objRange = objWorksheet.UsedRange
    
    objRange.Select

    Set objChart = objExcel.Charts.Add
    
    With objChart
        .Activate
        
        .ChartType = 65
        
        .PlotArea.Fill.PresetGradient 1, 1, 7
        On Error Resume Next
        .SeriesCollection(1).Border.Weight = -4138
        .SeriesCollection(2).Border.Weight = -4138
        .SeriesCollection(3).Border.Weight = -4138
        
        .SeriesCollection(1).Border.ColorIndex = 2
        .SeriesCollection(1).MarkerBackgroundColorIndex = 2
        
        .SeriesCollection(2).MarkerForegroundColorIndex = 1
        .SeriesCollection(3).MarkerForegroundColorIndex = 1
        On Error GoTo 0
        .HasTitle = True
        .ChartTitle.Text = ""
        .ChartTitle.Font.Size = 18
        
        .ChartArea.Fill.Visible = True
        .ChartArea.Fill.PresetTextured 15
        
        .ChartArea.Border.LineStyle = 1
        
        .HasLegend = True
        .Legend.Shadow = True
    End With '// objChart
End Sub

 

[mari_hitz]

Hi Ralajer, thanks for your prompt reply. The error that appears is the following:



Could you please let me know how can I give a Solution to this? I have to present this today and I could not find a way to improve this.
Also, I do not know if you or anyone can help me, the chart that the code creates is created accordingly, however I have to click after created the button "Switch Row/Colum", how can I make to make it directly without doing this? Or maybe add it to the code instead of doing it manually.

Thanks!!

 

[Ralajer]

Sorry if this is too late for you presentation but the below should work. I swap the row/columns and handle all the errors I could see.

Sub CommandButton1_Click()
    Dim oRangeSelected As Range
    
    Dim objExcel As Object
    Dim objWorkbook As Workbook
    Dim objWorksheet As Worksheet
    Dim objRange As Range

    Dim objChart As Chart
    
    Dim SeriesCount As Integer
    Dim i As Integer

    On Error Resume Next
    Set oRangeSelected = Application.InputBox( _
                Prompt:="Please select a range of cells!", _
                Title:="Select a Range", _
                Type:=8)
    On Error GoTo 0
    
    If oRangeSelected Is Nothing Then
        MsgBox "It appears as if you pressed cancel!"
        Exit Sub
    Else
        MsgBox "You selected: " & oRangeSelected.Address(External:=True)
    End If
                                                                            
    Set objExcel = CreateObject("Excel.Application")
    
    objExcel.Visible = True
    
    Set objWorkbook = objExcel.Workbooks.Add()
    Set objWorksheet = objWorkbook.Worksheets(1)

    oRangeSelected.Copy
    objWorksheet.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
    
    Set objRange = objWorksheet.UsedRange
    
    objRange.Select

    Set objChart = objExcel.Charts.Add
    
    With objChart
        SeriesCount = .SeriesCollection.Count
        .Activate
        .ChartType = 65
        
        .PlotArea.Fill.PresetGradient 1, 1, 7
        
        For i = 1 To SeriesCount
            .SeriesCollection(i).Border.Weight = -4138
        Next i
        
        .SeriesCollection(1).Border.ColorIndex = 2
        .SeriesCollection(1).MarkerBackgroundColorIndex = 2
        
        If SeriesCount > 1 Then
            For i = 2 To SeriesCount
                .SeriesCollection(i).MarkerForegroundColorIndex = 1
            Next i
        End If
        
        .HasTitle = True
        .ChartTitle.Font.Size = 18
        .ChartArea.Fill.Visible = True
        .ChartArea.Fill.PresetTextured 15
        
        .ChartArea.Border.LineStyle = 1
        
        .HasLegend = True
        .Legend.Shadow = True
        
        '// Switch Row/Columns to rows
        .PlotBy = xlRows

    End With '// objChart
End Sub

 

[mari_hitz]

Ralajer, do not apologize. You are an angel.
Thanks for all you have done for me!