Reputation:
I got this problem:
I am using VBA, to make some charts.
I made some input fields...those input fields are transferred via button to a table, and from that table, I draw the line chart.
Looks like this:
Answers in column D, they are all changeable, but the number is constant, always 12...
Then I got the table, where on button press, the answers are transferred:
Point is, on button click, I add a new row to the table, the last rows (from S to AB) are generic data, which I make with formulas out of the answers.
Once I add the new row, I also add the time stamp to the left side...
Now, I am ready to make a line chart...with the last 4 columns Y, Z, AA and AB I made it, but I don't know how to add the timestamp to be on the x axis.
Timestamp looks like this:
Here is the code of my button:
Sub AddData()
'
' AddData Macro
' Adds data to the table
'
' Keyboard Shortcut: Ctrl+d
'
Dim cellValue As Variant
Dim rowSize As Integer
Dim i As Integer
Dim myRange As Variant
Dim cell As Variant
Dim column_Position As Integer
Dim row_Position As Integer
Dim rangeFormula As Variant
rowSize = 12
row_Position = -1
Set myRange = range("G1:G1000")
'Find first empty row
For Each cell In myRange
If IsEmpty(cell.Value) Then
column_Position = cell.Column
row_Position = cell.row
Exit For
End If
Next cell
'Do for loop and fill the cells from G(7) to R(18) with data
For i = 1 To rowSize
cellValue = range("D2:D13").Cells(i).Value
range(Cells(row_Position, "G"), Cells(row_Position, "R")).Cells(i).Value = cellValue
Next i
'Copy formulas one row bellow, from S(19) to AB(28)
If row_Position > 4 Then
range(Cells(row_Position - 1, "S"), Cells(row_Position - 1, "AB")).Select
Selection.Copy
range(Cells(row_Position, "S"), Cells(row_Position, "AB")).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
:=False
End If
'Add timestamp to F cells
Cells(row_Position, "F") = Now()
Cells(row_Position, "F") = Format(Now(), "dd-mm-yyyy hh:mm:ss")
'Remove Selections
Cells(1, 1).Select
Application.CutCopyMode = False
'Delete all old charts
If Not Worksheets("Data").ChartObjects.Count = 0 Then
Worksheets("Data").ChartObjects.Delete
End If
'Draw a chart
Dim rng As range
Dim cht As ChartObject
'Your data range for the chart
Set rng = ActiveSheet.range(Cells(2, "Y"), Cells(row_Position, "AB"))
'Create a chart
Set cht = ActiveSheet.ChartObjects.Add( _
Left:=ActiveCell.Left, _
Width:=775, _
Top:=275, _
Height:=250)
'Populate chart with data
cht.Chart.SetSourceData Source:=rng
'Add gridlines
cht.Chart.Axes(xlCategory).HasMajorGridlines = True
'Determine the chart type
cht.Chart.ChartType = xlXYScatterLines
cht.Activate
cht.Chart.SeriesCollection(1).XValues = "=$F$4:$F$28"
End Sub
Now, I have something like this:
A line chart with the 4 rows I used to make the chart.
But I have no idea how to add the F(F4 to last filled row) column as the x axis.
Edit1: Forgot to mention, once I add the row to the table, the current chart is deleted, and I make a new one, with the all data as before, plus the new row...
Edit2: Thanks to Pierre44, I moved the timestamp column a row higher, and added one extra row, so that the arrays all have the same length...and it looks like this:
And it is almost done, but can you show me how to move the x axis, bellow the graph?
Like this:
Thanks.
Upvotes: 0
Views: 801
Reputation: 1741
One possible solution would be to define the whole range of your graph from the beginning:
For this you can replace:
Set rng = ActiveSheet.range(Cells(2, "Y"), Cells(row_Position, "AB"))
By:
Set rng = ActiveSheet.Range("Sheet1!$F$1:$F$" & row_Position & ",Sheet1!$Y$1:$AB$" & row_Position)
Note that I changed F4:F28 to "F1:F" & row_Position as you need to have as many values here as you have in the other columns
As your X values are quite long, you might want to change their orientation Example:
ActiveSheet.ChartObjects("Chart").Activate
ActiveChart.Axes(xlCategory).TickLabelPosition = xlLow
Upvotes: 1