I'm VERY new to VBA. I'm trying to write a code that will output 33 series. The x-values for the first series are in column A and the y-values for the first series are in column C. Then D and F. Then G and I....and so on. (So basically the x-values and y-values are every third column starting from A and C respectively). The values are in rows 2 to 25.
Also the name for each series is in the first row, every third column starting with 2.
The first 33 data points come out OK, but it continues on to produce a bunch on unintended data points. Is there a problem with my loop? Like I said I'm pretty new so it could be something super obvious. Thanks!
Here's my code:
Sub Scatter
Dim i As Int
Dim name As String
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterLinesNoMarkers
For i = 1 To 33
name = Cells(1, 3 * i - 1)
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(i).name = name
With Worksheets("Sheet1")
ActiveSheet.SeriesCollection(i).XValues = .range(.Cells(2, 3 * i - 2), .Cells(25, 3 * i - 2))
ActiveSheet.SeriesCollection(i).Values = .range(.Cells(2, 3 * i), .Cells(25, 3 * i))
End With
Next i
End Sub
Sub Scatter()
Dim i As Integer
Dim cht As Chart, sht As Worksheet
Set sht = ActiveSheet
Set cht = sht.Shapes.AddChart().Chart
cht.ChartType = xlXYScatterLinesNoMarkers
For i = 1 To 33
With cht.SeriesCollection.NewSeries()
.Name = sht.Cells(1, (3 * i) - 1)
.XValues = sht.Range(sht.Cells(2, (3 * i) - 2), sht.Cells(25, (3 * i) - 2))
.Values = sht.Range(sht.Cells(2, 3 * i), sht.Cells(25, 3 * i))
End With
Next i
End Sub
Related
I have a list of data and I need to generate a chart for every two lines and give a chart title associated to the 1st line. Example of the data is:
Example
And so on.
The code I am using to create the charts is:
Sub loopChart()
Dim mychart As Chart
Dim myRange As Range
Dim c As Integer
Dim r As Integer
Dim s As Integer
Dim ttl As String
r = 2
While r <= 10 '1=dataSource1, 4=dataSource2, 7=dataSource3
'set data source for the next chart
With Worksheets("Sheet9")
Set myRange = .Range(.Cells(r, 2), .Cells(r + 1, 14))
End With
'create chart
Sheets("Chart").Select
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
ttl = Range("A" & r)
.ChartType = xlLineMarkers 'xlLine
.SetSourceData Source:=myRange, PlotBy:=xlRows 'sets source data for graph including labels
.SetElement (msoElementLegendRight) 'including legend
.HasTitle = True
'dimentions & location:
.Parent.Top = 244 'defines the coordinates of the top of the chart
'.Parent.Left = r * 150 'defines the coordinates for the left side of the chart
.Parent.Height = 200
.Parent.Width = 300
.ChartTitle.Formula = ttl
End With
r = r + 2
Wend
End Sub
So, the 1st chart that generates should get the title on row 2, next chart should have title of row 4...
I always get the Chart title on 1st chart that generates but not on any of the other charts. Can anyone please help me on this?
Please fix below.
ttl = Range("A" & r)
to
ttl = Worksheets("Sheet9").Range("A" & r).Value
I think #Dy.Lee answer will do the trick but to go a bit further :
Try avoiding using .select
Proposed workaround :
Sub loopChart()
Dim Ch As Chart
Dim Sh1 As Worksheet: Set Sh1 = Sheets("Sheet9")
Dim Sh2 As Worksheet: Set Sh2 = Sheets("Chart")
Dim L As Integer
L = 0
For i = 2 To 18 Step 2
Set Ch = Sh2.Shapes.AddChart.Chart
Ch.SetSourceData Sh1.Range(Sh1.Cells(i, 2), Sh1.Cells(i + 1, 14))
Ch.ChartType = xlLineMarkers
Ch.SetElement (msoElementLegendRight)
Ch.HasTitle = True
Ch.Parent.Top = 244
Ch.Parent.Height = 200
Ch.Parent.Width = 300
Ch.Parent.Left = L
Ch.ChartTitle.Caption = Sh1.Cells(i, 1).Value
L = L + 300
Next i
End Sub
Your code will create each graph at the same location so you'll see only one (the last one) hence the Ch.Parent.Left line with variable value.
I wanna ask related to excel vba.
I'm trying to consolidate data from worksheet, containing data like screenshot(1).
What i'm want to do is to consolidate data with unique row is in row H (CTP.GRP) and sum column M(Nominal) populate to another sheet in column utlization & column P(Mtm in IDR) Popullate data to another sheet column market value
My code only sum one column, anyone can help with code how to sum two column?
Sub ins_data()
Dim x As Variant
Dim y As Variant
Dim countDict As Variant
Dim a As Long
Set countDict = CreateObject("Scripting.Dictionary")
x = Sheets("Data").Range("A2").CurrentRegion
ReDim y(1 To UBound(x, 1), 1 To UBound(x, 2))
For a = 2 To UBound(x, 1)
cat1 = x(a, 8)
val1 = x(a, 16)
If countDict.exists(cat1) Then
countDict(cat1) = countDict(cat1) + val1
Else
countDict(cat1) = val1
End If
Next a
i = 1
For Each d In countDict
y(i, 2) = d
y(i, 8) = countDict(d)
i = i + 1
Next d
ThisWorkbook.Sheets("X").Range("B5").Resize(UBound(y), UBound(y, 2)).Value = y
Expected result:
Edited after OP’s further clarification
you could use this code:
Option Explicit
Sub ins_data()
Dim countDict As Object, countDict2 As Object
Set countDict = CreateObject("Scripting.Dictionary")
Set countDict2 = CreateObject("Scripting.Dictionary")
Dim x() As Variant
x = Sheets("Data").Range("A2").CurrentRegion.Value2
Dim a As Long
For a = 2 To UBound(x, 1)
countDict(x(a, 8)) = countDict(x(a, 8)) + x(a, 13)
countDict2(x(a, 8)) = countDict(x(a, 8)) + x(a, 16)
Next
With ThisWorkbook.Sheets("X").Range("B5").Resize(countDict.Count) ‘ change “B5” to the actual worksheet “X” cell you want to start writing Sheets("Data")) column H unique values from
.Value = Application.Transpose(countDict.Keys)
.Offset(, 6).Value = Application.Transpose(countDict.Items) ‘ change “6” to your actual column offset from Sheets("X") referenced column (currently, “B”) you want to start writing Sheets("Data")) column M consolidated sum from
.Offset(, 7).Value = Application.Transpose(countDict2.Items) ‘ change “7” to your actual column offset from Sheets("X") referenced column (currently, “B”) you want to start writing Sheets("Data")) column P consolidated sum from
End With
End Sub
The following code succesfully generates an XY scatter plot with dynamically changing ranges. However, the hurdle I can't get over is how to programmatically set the x,y,z values for the scatterplot to generate a bubble chart. I've made attempt at doing so(as you can see in the code) but it doesn't work.
Any helps is appreciated
dim a as long
dim b as long
dim i as long
dim m as long
dim j as long
For i = 2 To lastrow
If Cells(i, "A") = "Regression #" & m & " Output" Then
a = i 'save regression #1 row number, where it begins
For j = 2 To a
If Cells(j, "A") = "Regression #" & m + 1 & " Output" Then
b = j
End If
Next j
Set rngx = Range(Cells(b + 1, 2), Cells(a - 1, 2))
Set rngy = Range(Cells(b + 1, 7), Cells(a - 1, 7))
Set rngz = Range(Cells(b + 1, 8), Cells(a - 1, 8))
Sheets("Chart Table").Shapes.AddChart.Select
ActiveChart.ChartType = xlBubble
ActiveChart.SetSourceData Source:=Union(rngx, rngy, rngz)
With ActiveChart.SeriesCollection.NewSeries
'.Name = ActiveSheet.Range("B2:B13")
.value = rngy
.xvalues = rngx
.BubbleSizes = rngz
End With
With ActiveChart
.SetElement (msoElementChartTitleAboveChart)
.Legend.Delete
.ChartTitle.Select
.ChartTitle.Text = Cells(a, 1).Value
End With
Else
End If
Next i
For example, if I have just one row of data(one x, one y, one z) - then I want Excel to know that it means there's only one bubble. Right now it reads it as 3 separate bubbles, disregarding the fact there's a bubble sizing element
If the union of rngx, rngy, and rngz is a contiguous range, it works fine. Since these ranges are separated by several columns, your SetSourceData command is incomplete, and treats their union as a set of Y values, and uses the default (1, 2, 3) as X values and (1, 1, 1) as bubble sizes.
However, this small change fixes your code:
ActiveChart.SetSourceData Source:=Union(rngx, rngy, rngz), PlotBy:=xlColumns
I need additional info in sheet2, but I cant figure out how to add this.
I have in sheet1 a lot of data, but everything is divided into 3 sections
Section 1 of sheet1 is in columns A,B,C,D and contains -date,time,name,last
Section 2 of sheet1 is numeric data and its range is columns E to JX
Section 3 of sheet1 is in range JY:MV and it contains results(from section2)
Code that I have goes through section 3 and if value is <1 it copies that value into sheet 2 in column F, and it copies from that row section 1
Example:
If value 0.5 is found in sheet1 K32, sheet 2 looks like :
A B C D F
date time name last 0.5
Tasks that I need help
1)Is it possible to see in sheet2 in column E a sheet1 column name from where is value found?
2) Since every value in section 3 is result from 2 values from section2, can both of these values also be copies to sheet 2?
For Example
In sheet1, K50 is 0.2 and that result is from AA50(2.2) and AC50(2.0),formula used is (AA-AC)
Is it possible to copy 2.2 and 2.0 in sheet 2 also based on formula cell reference?
Summary:
Final sheet2 should look like this:
A B C D E F G H
date, time, name, last, Column name where value is found, value, data1, data2
So I need help do add columns E,G and H
Sub moveData()
Dim rng As Range
Dim iniCol As Range
Dim i
Dim v
Dim x
Dim myIndex
Dim cellVal
Dim totalCols
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim ABC() 'var to store data from Cols A,B,C in Sheet1
Dim JYJZKA As Range 'var to store data from Cols K,L,M in Sheet1
Set sht1 = Sheets("Sheet1")
Set sht2 = Sheets("Sheet2")
Set rng = Range("JY1:KB400")
Set iniCol = Range("JY1:JY400")
totalCols = rng.Columns.Count 'Count the total of columns in the selectec range
myIndex = 0 'ini the index for rows in sheet2
For Each i In iniCol
x = -1
ABC = Range(Cells(i.Row, 1), Cells(i.Row, 4))
Set JYJZKA = Range(Cells(i.Row, 285), Cells(i.Row, 351))
'Copy range from A to C
sht2.Activate
myIndex = Application.WorksheetFunction.CountA(Columns(1)) + 1
For Each v In JYJZKA
If v.Value < 1 Then
x = x + 1
Range(Cells(myIndex + x, 6), Cells(myIndex + x, 6)).Value = v.Value
Range(Cells(myIndex + x, 1), Cells(myIndex + x, 4)).Value = ABC
End If
Next v
'Paste range equal to copy range.
'Application.CutCopyMode = False
sht1.Activate
Next i
End Sub
See if this can get your started.
I've loaded the large block of data into a variant array. This greatly speeds up the looping through individual cell comparisons.
Sub section_3_to_Sheet2()
Dim r As Long, c As Long, vVALs As Variant, vTMP As Variant
With Worksheets("Sheet1")
With .Range(.Cells(2, 1), .Cells(Rows.Count, "MV").End(xlUp))
vVALs = .Value2
End With
End With
With Worksheets("Sheet2")
For r = LBound(vVALs, 1) To UBound(vVALs, 1)
For c = 285 To UBound(vVALs, 2)
If vVALs(r, c) < 1 Then
vTMP = Array(vVALs(r, 1), vVALs(r, 2), vVALs(r, 3), vVALs(r, 4), _
"=ADDRESS(" & r + 1 & ", " & c & ", 4, 1, """ & .Name & """)", _
vVALs(r, c), vVALs(r, c - 280))
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 7) = vTMP
End If
Next c
Next r
End With
End Sub
Typically, blocks of data like this have column header labels so I started you off in row 2, not row1 as your sample data might indicate.
The location of the original data is supplied with an ADDRESS function.
Since E:JX is not the same number of columns as JY:MV, I was a little confused on what value to return as the second (e.g. data2) value. I opted for a simple offset.
I was sent an Excel sheet that with 4 charts. The data for the charts is in another workbook that was not provided.
Goal: I want to extract the data from the charts using a VBA sub.
Problem: I am having some trouble with "type mismatch." When I try to assign the Variant array oSeries.XValues to a Range of cells.
Option Explicit
Option Base 1
' 1. Enter the following macro code in a module sheet.
' 2. Select the chart from which you want to extract the underlying data values.
' 3. Run the GetChartValues Sub. The data from the chart is placed in a new worksheet named "ChartName Data".
'
Sub GetChartValues()
'
Dim lxNumberOfRows As Long
Dim lyNumberOfRows As Long
Dim oSeries As Series
Dim lCounter As Long
Dim oWorksheet As Worksheet
Dim oChart As Chart
Dim xValues() As Variant
Dim yValues() As Variant
Dim xDestination As Range
Dim yDestination As Range
Set oChart = ActiveChart
' If a chart is not active, just exit
If oChart Is Nothing Then
Exit Sub
End If
' Create the worksheet for storing data
Set oWorksheet = ActiveWorkbook.Worksheets.Add
oWorksheet.Name = oChart.Name & " Data"
' Loop through all series in the chart and write there values to
' the worksheet.
lCounter = 1
For Each oSeries In oChart.SeriesCollection
xValues = oSeries.xValues
yValues = oSeries.values
' Calculate the number of rows of data. 1048576 is maximum number of rows in excel.
lxNumberOfRows = WorksheetFunction.Min(UBound(oSeries.xValues), 1048576 - 1)
lyNumberOfRows = WorksheetFunction.Min(UBound(oSeries.values), 1048576 - 1)
' Sometimes the Array is to big, so chop off the end
ReDim Preserve xValues(lxNumberOfRows)
ReDim Preserve yValues(lyNumberOfRows)
With oWorksheet
' Put the name of the series at the top of each column
.Cells(1, 2 * lCounter - 1) = oSeries.Name
.Cells(1, 2 * lCounter) = oSeries.Name
Set xDestination = .Range(.Cells(1, 2 * lCounter - 1), .Cells(lxNumberOfRows + 1, 2 * lCounter - 1))
Set yDestination = .Range(.Cells(1, 2 * lCounter), .Cells(lxNumberOfRows + 1, 2 * lCounter))
'Assign the x and y data from the chart to a range in the worksheet
xDestination.value = Application.Transpose(xValues)
yDestination.value = Application.Transpose(yValues)
' This does not work either
' .Range(.Cells(2, 2 * lCounter - 1), .Cells(lxNumberOfRows + 1, 2 * lCounter - 1)).value = Application.Transpose(oSeries.xValues)
' .Range(.Cells(2, 2 * lCounter), .Cells(lxNumberOfRows + 1, 2 * lCounter)).value = Application.Transpose(oSeries.values)
End With
lCounter = lCounter + 1
Next
' Cleanup
Set oChart = Nothing
Set oWorksheet = Nothing
End Sub
The main issue is the following lines:
.Range(.Cells(2, 2 * lCounter - 1), .Cells(lxNumberOfRows + 1, 2 * lCounter - 1)) = Application.Transpose(oSeries.xValues)
.Range(.Cells(2, 2 * lCounter), .Cells(lxNumberOfRows + 1, 2 * lCounter)) = Application.Transpose(oSeries.values)
Upon further inspection using the Locals window, I find the following:
The below code works while the above code does not.
Sub Test2()
Dim A(6) As Variant
'A(1) = 1
A(2) = 2#
A(3) = 3#
A(4) = 4#
A(5) = 5#
Range(Cells(1, 1), Cells(6, 1)).value = Application.Transpose(A)
End Sub
Why doesn't the first piece of code work?
Looping over many cells is slow in this case (I've tried). Please, don't use a loop unless it is seconds for 1,000,000 element.
The main cause is the built-in Transpose function. Transpose can only handle arrays with 2^16 or less elements.
The code below works well. It handles the problem of Transpose function limitation of 2^16 elements. It uses a for loop but the for loop is fast for arrays. For four series and each having 1048576 elements, the Sub took about 10 seconds to run. This is acceptable.
Option Explicit
Option Base 1
' 1. Enter the following macro code in a module sheet.
' 2. Select the chart from which you want to extract the underlying data values.
' 3. Run the GetChartValues Sub. The data from the chart is placed in a new worksheet named "ChartName Data".
'
Public Sub GetChartValues()
Dim lxNumberOfRows As Long
Dim lyNumberOfRows As Long
Dim oSeries As Series
Dim lSeriesCounter As Long
Dim oWorksheet As Worksheet
Dim oChart As Chart
Dim xValues() As Variant
Dim yValues() As Variant
Dim xDestination As Range
Dim yDestination As Range
Set oChart = ActiveChart
' If a chart is not active, just exit
If oChart Is Nothing Then
Exit Sub
End If
' Create the worksheet for storing data
Set oWorksheet = ActiveWorkbook.Worksheets.Add
oWorksheet.Name = oChart.Name & " Data"
' Loop through all series in the chart and write their values to the worksheet.
lSeriesCounter = 1
For Each oSeries In oChart.SeriesCollection
' Get the x and y values
xValues = oSeries.xValues
yValues = oSeries.values
' Calculate the number of rows of data.
lxNumberOfRows = UBound(xValues)
lyNumberOfRows = UBound(yValues)
' 1048576 is maximum number of rows in excel. Sometimes the Array is too big. Chop off the end.
If lxNumberOfRows >= 1048576 Then
lxNumberOfRows = 1048576 - 1
ReDim Preserve xValues(lxNumberOfRows)
End If
If lyNumberOfRows >= 1048576 Then
lyNumberOfRows = 1048576 - 1
ReDim Preserve yValues(lyNumberOfRows)
End If
With oWorksheet
' Put the name of the series at the top of each column
.Cells(1, 2 * lSeriesCounter - 1) = oSeries.Name & " X Values"
.Cells(1, 2 * lSeriesCounter) = oSeries.Name & " Y Values"
Set xDestination = .Range(.Cells(2, 2 * lSeriesCounter - 1), .Cells(lxNumberOfRows + 1, 2 * lSeriesCounter - 1))
Set yDestination = .Range(.Cells(2, 2 * lSeriesCounter), .Cells(lxNumberOfRows + 1, 2 * lSeriesCounter))
End With
' Arrays larger than 2^16 will fail with Transpose function. Therefore must manually transpose
If lxNumberOfRows > 2& ^ 16 Then
'Assign the x and y data from the chart to a range in the worksheet. Use the ManualTranspose for 2^16 or more elements.
xDestination.value = ManualTranspose(xValues)
yDestination.value = ManualTranspose(yValues)
Else
'Assign the x and y data from the chart to a range in the worksheet. Use the built-in Transpose for less than 2^16 elements.
xDestination.value = WorksheetFunction.Transpose(xValues)
yDestination.value = WorksheetFunction.Transpose(yValues)
End If
lSeriesCounter = lSeriesCounter + 1
Next
' Cleanup
Set oChart = Nothing
Set oWorksheet = Nothing
End Sub
' Helper function for when built-in Transpose function cannot be used. Arrays larger than 2^16 must be transposed manually.
Private Function ManualTranspose(ByRef arr As Variant) As Variant
Dim arrLength As Long
Dim i As Long
Dim TransposedArray() As Variant
arrLength = UBound(arr)
ReDim TransposedArray(arrLength, 1)
For i = 1 To arrLength
TransposedArray(i, 1) = arr(i)
Next i
ManualTranspose = TransposedArray
End Function