Reputation: 15
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?
Upvotes: 0
Views: 108
Reputation: 7567
.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
Upvotes: 0
Reputation: 8104
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!
Upvotes: 1
Reputation: 43585
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
Upvotes: 0