VBA chart creation from scattered data rows - excel

Question

I'm creating a UI for entering, editing, exporting, importing patient data (cholesterol biomarkers).
I've encountered a problem with the need to display available data from a "Data" worksheet.
The Data looks like this:
What I need is to create a chart from available data of ,, Elizbeth Norton,, with date in X-axis and Chol, Trig, LDL, HDL (separate lines) in Y-axis.
The results are being managed by using a Userform with a Listbox (from which a button should create the chart when found data is selected. Data is selected in a Listbox)
and this code finds needed data and puts selected results into an array
The Userform:
Code to find needed data:
If Len(f_FindAll.TextBox_Find.Value) >= 3 Then 'Do search if text in find box is longer than 3 character.
Set SearchRange = ActiveWorkbook.Worksheets("Data").Range("C:E").Cells
FindWhat = f_FindAll.TextBox_Find.Value
'Calls the FindAll function
Set FoundCells = FindAll(SearchRange:=SearchRange, _
FindWhat:=FindWhat, _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
MatchCase:=False, _
BeginsWith:=vbNullString, _
EndsWith:=vbNullString, _
BeginEndCompare:=vbTextCompare)
If FoundCells Is Nothing Then
ReDim arrResults(1 To 1, 1 To 5)
arrResults(1, 1) = "Data not found!!!"
Else
'Add results of FindAll to an array
ReDim arrResults(1 To FoundCells.Count, 1 To 5)
lFound = 1
For Each FoundCell In FoundCells
If FoundCell.Column = 3 Then
arrResults(lFound, 1) = FoundCell.Offset(0, -1).Value
arrResults(lFound, 2) = FoundCell.Value
arrResults(lFound, 3) = FoundCell.Offset(0, 1).Value
arrResults(lFound, 4) = FoundCell.Offset(0, 2).Value
arrResults(lFound, 5) = FoundCell.Address
lFound = lFound + 1
Else
If FoundCell.Column = 4 Then
arrResults(lFound, 1) = FoundCell.Offset(0, -2).Value
arrResults(lFound, 2) = FoundCell.Offset(0, -1).Value
arrResults(lFound, 3) = FoundCell.Value
arrResults(lFound, 4) = FoundCell.Offset(0, 1).Value
arrResults(lFound, 5) = FoundCell.Address
lFound = lFound + 1
Else
If FoundCell.Column = 5 Then
arrResults(lFound, 1) = FoundCell.Offset(0, -3).Value
arrResults(lFound, 2) = FoundCell.Offset(0, -2).Value
arrResults(lFound, 3) = FoundCell.Offset(0, -1).Value
arrResults(lFound, 4) = FoundCell.Value
arrResults(lFound, 5) = FoundCell.Address
lFound = lFound + 1
End If
End If
End If
Next FoundCell
End If
'Populate the listbox with the array
Me.ListBox_Results.List = arrResults
Code to display selected data in a user form:
Private Sub ListBox_Results_Click()
'Go to selection on the sheet when the result is clicked
Dim strAddress As String
Dim l As Integer
For l = 0 To ListBox_Results.ListCount
If ListBox_Results.Selected(l) = True Then
strAddress = ListBox_Results.List(l, 4)
Rownum = Range(strAddress).Row
Colnum = Range(strAddress).Column
ActiveWorkbook.Worksheets("Data").Select
Cells(Rownum, Colnum).Select
'Populate textboxes with results
'and maybe populate chart data range with results aswell????
With ActiveWorkbook.Worksheets("Data")
f_FindAll.TextBox_Results1.Value = .Cells(.Range(strAddress).Row, 1).Value
f_FindAll.TextBox_Results2.Value = .Cells(.Range(strAddress).Row, 2).Value
f_FindAll.TextBox_Results3.Value = .Cells(.Range(strAddress).Row, 3).Value
f_FindAll.TextBox_Results4.Value = .Cells(.Range(strAddress).Row, 4).Value
f_FindAll.TextBox_Results5.Value = .Cells(.Range(strAddress).Row, 5).Value
f_FindAll.TextBox_Results6.Value = .Cells(.Range(strAddress).Row, 6).Value
f_FindAll.TextBox_Results7.Value = .Cells(.Range(strAddress).Row, 7).Value
f_FindAll.TextBox_Results8.Value = .Cells(.Range(strAddress).Row, 8).Value
f_FindAll.TextBox_Results9.Value = .Cells(.Range(strAddress).Row, 9).Value
f_FindAll.TextBox_Results10.Value = .Cells(.Range(strAddress).Row, 10).Value
f_FindAll.TextBox_Results11.Value = .Cells(.Range(strAddress).Row, 11).Value
f_FindAll.TextBox_Results12.Value = .Cells(.Range(strAddress).Row, 12).Value
End With
GoTo EndLoop
End If
Next l
EndLoop:
End Sub
So what would be the best option? Maybe instead sort the data in sheet "Data" and create a chart from the selected range?
Thank you for your help.

Answer 1

One way would be to build a collection of row numbers and then use them to create arrays for each series of the chart. Alternatively dump the array to another sheet and use that as the source data.
Option Explicit
Sub PlotData()
Dim wb As Workbook, ws As Worksheet
Dim rngSearch As Range, rngFound As Range
Dim FindWhat As String, FirstFound As String
Dim datarows As Collection, ar
Dim r As Long, i As Integer, n As Integer
Set wb = ThisWorkbook
Set ws = wb.Sheets("Data")
Set datarows = New Collection
Set rngSearch = ws.UsedRange.Columns("C:E")
' build collection of rows
FindWhat = "11342"
Set rngFound = rngSearch.Find(FindWhat, _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByColumns, MatchCase:=False)
If rngFound Is Nothing Then
' no match
Exit Sub
Else
FirstFound = rngFound.Address
Do
n = n + 1
datarows.Add rngFound.Row, CStr(n)
Set rngFound = rngSearch.FindNext(After:=rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <> FirstFound
End If
' fill array
ReDim ar(1 To n, 1 To 5), x(n - 1), y(n - 1)
Dim sname
sname = Array("date", "chol", "trig", "LDL", "HDL")
For i = 1 To n
With ws
r = datarows(i)
x(i - 1) = .Cells(r, "B") 'date
ar(i, 1) = .Cells(r, "B") 'date
ar(i, 2) = .Cells(r, "I") 'chol
ar(i, 3) = .Cells(r, "J") 'trig
ar(i, 4) = .Cells(r, "K") 'LDL
ar(i, 5) = .Cells(r, "L") 'HDL
End With
Next
' copy to sheet if required as source data for plot
'Sheet2.Range("A1:E1") = sname
'Sheet2.Range("A2:E" & n + 1) = ar
' plot graph
Dim cht As Chart, c As Integer, srs As Series
Set cht = ws.Shapes.AddChart(xlLineMarkers).Chart
With cht
.HasTitle = True
.ChartTitle.Text = FindWhat
For c = 2 To 5
'Define the array of values for each series
For i = 1 To n
y(i - 1) = ar(i, c)
Next
Set srs = .SeriesCollection.NewSeries
With srs
.XValues = x
.Values = y
.name = sname(c - 1)
End With
Next
.Location Where:=xlLocationAsNewSheet, name:=FindWhat
End With
MsgBox "Done"
End Sub