0

This is the code :

Sub Charter()

Rows("1:3").Delete
Columns(1).EntireColumn.Delete
Columns("A").Insert
Columns("C").Copy Columns("A")
Columns("C").Delete

With Range("A:A")
    .Value = Evaluate(.Address & "*25.51")
End With

With Range("B:B")
    .Value = Evaluate(.Address & "*50")
End With
With Range("D:D")
    .Value = Evaluate(.Address & "*30.12")
End With



Dim rngDataSource As Range
Dim iDataRowsCt As Long
Dim iDataColsCt As Integer
Dim iSrsIx As Integer
Dim chtChart As Chart
Dim srsNew As Series

Columns("A:D").Select
If Not TypeName(Selection) = "Range" Then
    '' Doesn't work if no range is selected
    MsgBox "Please select a data range and try again.", _
        vbExclamation, "No Range Selected"
Else
    Set rngDataSource = Selection
    With rngDataSource
        iDataRowsCt = .Rows.Count
        iDataColsCt = .Columns.Count
    End With
    If iDataColsCt Mod 2 > 0 Then
        MsgBox "Select a range with an EVEN number of columns.", _
            vbExclamation, "Select Even Number of Columns"
        Exit Sub
    End If

    '' Create the chart
    Set chtChart = ActiveSheet.ChartObjects.Add( _
        Left:=ActiveSheet.Columns(ActiveWindow.ScrollColumn).Left + _
            ActiveWindow.Width / 4, _
        Width:=ActiveWindow.Width / 2, _
        Top:=ActiveSheet.Rows(ActiveWindow.ScrollRow).Top + _
            ActiveWindow.Height / 4, _
        Height:=ActiveWindow.Height / 2).Chart

    With chtChart
        .ChartType = xlXYScatterSmoothNoMarkers

        '' Remove any series created with the chart
        Do Until .SeriesCollection.Count = 0
            .SeriesCollection(1).Delete
        Loop

        For iSrsIx = 1 To iDataColsCt - 1 Step 2
            '' Add each series
            Set srsNew = .SeriesCollection.NewSeries
            With srsNew
                .Name = rngDataSource.Cells(1, iSrsIx + 1)
                .Values = rngDataSource.Cells(2, iSrsIx + 1) _
                    .Resize(iDataRowsCt - 1, 1)
                .XValues = rngDataSource.Cells(2, iSrsIx) _
                    .Resize(iDataRowsCt - 1, 1)
            End With
        Next
    End With
End If
End Sub

There are supposed to be 4 columns A,B,C and D as a result of the first few lines of this code (used to change up an existing excel sheet format). I am trying to graph the Columns B,C and D against Column A as the x axis. But my result right now only shows 2 series instead of 3, and seems to have got the axis wrong. What is the error in the logic?

Sam Bob
  • 15
  • 6
  • Is there a good reason for applying the result of `Evaluate` to the *entire* column (in Excel 2007+ this is over 1 million rows of data). What is the specific error message you're getting? – David Zemens Jul 24 '17 at 14:57
  • @DavidZemens My objective was to multiply all values in that column by a value. Ideally, i only need to do it for filled cells. Is there a way for that? My error was a runtime error 13. – Sam Bob Jul 24 '17 at 15:05
  • use [this](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba) to determine the "last" cell and define appropriate ranges based on that. https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-vba – David Zemens Jul 24 '17 at 15:06
  • @DavidZemens Thanks! – Sam Bob Jul 24 '17 at 15:28

3 Answers3

1

Since you want your first column to be your X-axis, and your second, third, and fourth columns to be your values for each of your series, first declare the following additional variable...

Dim rngChrtXVals as Range

Then amend your With/End With statement as follows...

With chtChart
    .ChartType = xlXYScatterSmoothNoMarkers

    '' Remove any series created with the chart
    Do Until .SeriesCollection.Count = 0
        .SeriesCollection(1).Delete
    Loop

    Set rngChrtXVals = rngDataSource.Cells(2, 1) _
        .Resize(iDataRowsCt - 1, 1)

    For iSrsIx = 2 To iDataColsCt
        '' Add each series
        Set srsNew = .SeriesCollection.NewSeries
        With srsNew
            .Name = rngDataSource.Cells(1, iSrsIx)
            .Values = rngDataSource.Cells(2, iSrsIx) _
                .Resize(iDataRowsCt - 1, 1)
            .XValues = rngChrtXVals
        End With
    Next
End With

Hope this helps!

Domenic
  • 7,844
  • 2
  • 9
  • 17
0

You are looking for an error in the logic. This is it:

With Range("A:A")
    .value = Evaluate(.Address & "*25.51")
End With

What do you expect from this 3 lines as an output? If possible, provide screenshot in your question.


Here is how to make it a bit workable. - Open a new workbook - In column A write a few random values - Run the TestMe code line by line (using F8)

Option Explicit

Public Sub TestMe()

    Dim lngFirstLine    As Long
    Dim lngLastLine     As Long
    Dim rngCell         As Range

    lngFirstLine = 1
    lngLastLine = lastRow(ActiveSheet.Name, 1)

    With ActiveSheet
        For Each rngCell In .Range(.Cells(lngFirstLine, 1), .Cells(lngLastLine, 1))
            rngCell = rngCell * 25.51
        Next rngCell
    End With

End Sub

Function lastRow(Optional strSheet As String, Optional column_to_check As Long = 1) As Long

    Dim shSheet  As Worksheet

        If strSheet = vbNullString Then
            Set shSheet = ActiveSheet
        Else
            Set shSheet = Worksheets(strSheet)
        End If

    lastRow = shSheet.Cells(shSheet.Rows.Count, column_to_check).End(xlUp).Row

End Function
Vityata
  • 42,633
  • 8
  • 55
  • 100
0

.XValues range and Values range is incorrect.

    For iSrsIx = 2 To iDataColsCt Step 1
        '' Add each series
        Set srsNew = .SeriesCollection.NewSeries
        With srsNew
            .Name = rngDataSource.Cells(1, iSrsIx)
            .Values = rngDataSource.Cells(2, iSrsIx) _
                .Resize(iDataRowsCt - 1, 1)
            .XValues = rngDataSource.Cells(2, 1) _
                .Resize(iDataRowsCt - 1, 1)
        End With
    Next
Dy.Lee
  • 7,527
  • 1
  • 12
  • 14