Data formatting for Chart

[IREALLYambatman]

Hi guys, I have a macro where I am trying to create a chart where the X axis are dates, those values are currently in the format seen below seperated by a '|'.. I first take that cell of data, seperate it, then attempt to plot the data for the array. Does anyone know what I'm doing wrong?
The output I'm getting:

Some Example Date Formatting (far more data then this..):

5/19/2023 8:42:00 AM|5/11/2023 9:27:00 AM|4/13/2023 1:04:00 PM

Most likely problematic Parts Of code:

valueArray = Split(valueCSV, "|")
    dateArray = Split(dateCSV, "|")

    If UBound(valueArray) <> UBound(dateArray) Then
        MsgBox "Mismatch in the number of values and dates"
        Exit Sub
    End If
....more code...
        Set dataSeries = .SeriesCollection.NewSeries
        With dataSeries
            .XValues = dateArray
            .values = valuesArray
            .Name = "Data Series"
        End With

        ' Add high and low control limits as lines
        Set dataSeries = .SeriesCollection.NewSeries
        With dataSeries
            .XValues = dateArray
            .values = highLimitArray
            .Name = "High Control Limit"
            .ChartType = xlXYScatterLinesNoMarkers
        End With

        Set dataSeries = .SeriesCollection.NewSeries
        With dataSeries
            .XValues = dateArray
            .values = lowLimitArray
            .Name = "Low Control Limit"
            .ChartType = xlXYScatterLinesNoMarkers
        End With

        .Axes(xlCategory, xlPrimary).CategoryType = xlTimeScale
        .Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "mmm-dd-yyyy"
...more formatting stuff..

Whole Macro:

Sub Chart()
    Dim ws As Worksheet
    Dim headerRange As Range, cell As Range
    Dim selectedHeader As String
    Dim valueCSV As String, dateCSV As String
    Dim lowValue As Double, highValue As Double
    Dim valueArray() As String, dateArray() As String
    Dim highLimitArray() As Double, lowLimitArray() As Double
    Dim i As Long
    Dim chartObj As ChartObject
    Dim dataSeries As Series
    Dim rowNumber As Long, lastRow As Long

    Set ws = ThisWorkbook.Sheets("Calculator")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
    Set headerRange = ws.Range("A16:A" & lastRow)

    selectedHeader = ws.Range("G6").Value

    For Each cell In headerRange
        If cell.Value = selectedHeader Then
            rowNumber = cell.row
            Exit For
        End If
    Next cell

    If rowNumber = 0 Then
        MsgBox "Header not found"
        Exit Sub
    End If

    valueCSV = ws.Range("M" & rowNumber).Value
    dateCSV = ws.Range("N" & rowNumber).Value
    lowValue = ws.Range("E" & rowNumber).Value
    highValue = ws.Range("F" & rowNumber).Value

    valueArray = Split(valueCSV, "|")
    dateArray = Split(dateCSV, "|")

    If UBound(valueArray) <> UBound(dateArray) Then
        MsgBox "Mismatch in the number of values and dates"
        Exit Sub
    End If

    ReDim highLimitArray(1 To UBound(dateArray) + 1)
    ReDim lowLimitArray(1 To UBound(dateArray) + 1)
    For i = 1 To UBound(dateArray) + 1
        highLimitArray(i) = highValue
        lowLimitArray(i) = lowValue
    Next i

    Set chartObj = ws.ChartObjects.Add(Left:=100, Width:=375, Top:=50, Height:=225)
    With chartObj.Chart
        .ChartType = xlXYScatter

        ' Convert string array to double array for plotting
        Dim valuesArray() As Double
        ReDim valuesArray(1 To UBound(valueArray) + 1)
        For i = LBound(valueArray) To UBound(valueArray)
            valuesArray(i + 1) = CDbl(valueArray(i))
        Next i

        Set dataSeries = .SeriesCollection.NewSeries
        With dataSeries
            .XValues = dateArray
            .values = valuesArray
            .Name = "Data Series"
            '.MarkerStyle = xlMarkerStyleCircle
            '.MarkerSize = 5
            '.MarkerBackgroundColor = RGB(0, 0, 255) ' Blue markers
            '.MarkerForegroundColor = RGB(0, 0, 255) ' Blue markers
        End With

        ' Add high and low control limits as lines
        Set dataSeries = .SeriesCollection.NewSeries
        With dataSeries
            .XValues = dateArray
            .values = highLimitArray
            .Name = "High Control Limit"
            .ChartType = xlXYScatterLinesNoMarkers
            '.Format.Line.ForeColor.RGB = RGB(255, 0, 0) ' Red line for high limit
        End With

        Set dataSeries = .SeriesCollection.NewSeries
        With dataSeries
            .XValues = dateArray
            .values = lowLimitArray
            .Name = "Low Control Limit"
            .ChartType = xlXYScatterLinesNoMarkers
            '.Format.Line.ForeColor.RGB = RGB(0, 255, 0) ' Green line for low limit
        End With

        .Axes(xlCategory, xlPrimary).CategoryType = xlTimeScale
        .Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "mmm-dd-yyyy"
        .HasTitle = True
        .ChartTitle.Text = selectedHeader
        .ClearToMatchStyle
        .ChartStyle = 268
    End With
End Sub

 

[gplhl]

Looks like it is a formatting issue, would this not be easier with a query to import and manipulate data?

 

[IREALLYambatman]

Hi @gplhl, I'm 1000% sure that there's a better way to do this but I honestly am not good enough in my VBA to do it. Setting up the existing data as a | seperated value took all I had + a lot of chatGPT's help.

 

[IREALLYambatman]

Im sure there's a better way to do it, but this works:

Sub Chart()
    Dim ws As Worksheet
    Dim headerRange As Range, cell As Range
    Dim selectedHeader As String
    Dim valueCSV As String, dateCSV As String
    Dim lowValue As Double, highValue As Double
    Dim valueArray() As String, dateArray() As String
    Dim highLimitArray() As Double, lowLimitArray() As Double
    Dim i As Long
    Dim chartObj As ChartObject
    Dim dataSeries As Series
    Dim rowNumber As Long, lastRow As Long

    Set ws = ThisWorkbook.Sheets("Calculator")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
    Set headerRange = ws.Range("A16:A" & lastRow)
    selectedHeader = ws.Range("G6").Value

    For Each cell In headerRange
        If cell.Value = selectedHeader Then
            rowNumber = cell.row
            Exit For
        End If
    Next cell

    If rowNumber = 0 Then
        MsgBox "Header not found"
        Exit Sub
    End If

    valueCSV = ws.Range("M" & rowNumber).Value
    dateCSV = ws.Range("N" & rowNumber).Value
    lowValue = ws.Range("E" & rowNumber).Value
    highValue = ws.Range("F" & rowNumber).Value

    valueArray = Split(valueCSV, "|")
    dateArray = Split(dateCSV, "|")

    If UBound(valueArray) <> UBound(dateArray) Then
        MsgBox "Mismatch in the number of values and dates"
        Exit Sub
    End If

    ReDim highLimitArray(1 To UBound(dateArray) + 1)
    ReDim lowLimitArray(1 To UBound(dateArray) + 1)
    For i = 1 To UBound(dateArray) + 1
        highLimitArray(i) = highValue
        lowLimitArray(i) = lowValue
    Next i

    ws.Range("O1:P" & lastRow).ClearContents

    For i = LBound(dateArray) To UBound(dateArray)
        ws.Cells(i + 1, 15).Value = CDbl(valueArray(i))
        Dim dateParts() As String
        dateParts = Split(dateArray(i), "/")
        Dim yearPart As String, monthPart As String, dayPart As String
        monthPart = dateParts(0)
        dayPart = Split(dateParts(1), " ")(0)
        yearPart = Split(dateParts(2), " ")(0)
        ws.Cells(i + 1, 16).Value = DateSerial(yearPart, monthPart, dayPart)
    Next i

    Dim minDate As Date, maxDate As Date
    maxDate = dateValue(Split(dateArray(LBound(dateArray)), " ")(0))
    minDate = dateValue(Split(dateArray(UBound(dateArray)), " ")(0))
    
    Dim MI As Integer
    MI = 7200 / UBound(dateArray)

    Set chartObj = ws.ChartObjects.Add(Left:=10, Width:=900, Top:=150, Height:=300)
    With chartObj.Chart
        .ChartType = xlXYScatter
        Set dataSeries = .SeriesCollection.NewSeries
        With dataSeries
            .XValues = ws.Range("P2:P" & UBound(dateArray) + 2)
            .values = ws.Range("O2:O" & UBound(valueArray) + 2)
            .Name = "Data Series"
        End With

        Set dataSeries = .SeriesCollection.NewSeries
        With dataSeries
            .XValues = ws.Range("P2:P" & UBound(dateArray) + 2)
            .values = highLimitArray
            .Name = "High Control Limit"
            .ChartType = xlXYScatterLinesNoMarkers
        End With

        Set dataSeries = .SeriesCollection.NewSeries
        With dataSeries
            .XValues = ws.Range("P2:P" & UBound(dateArray) + 2)
            .values = lowLimitArray
            .Name = "Low Control Limit"
            .ChartType = xlXYScatterLinesNoMarkers
        End With

        With .Axes(xlCategory, xlPrimary)
            .MinimumScale = CLng(minDate)
            .MaximumScale = CLng(maxDate)
            .CategoryType = xlTimeScale
            .MajorUnit = MI
            .MajorUnitIsAuto = False
            .TickLabels.Orientation = 45
            .TickLabels.NumberFormat = "mmm-dd-yyyy"
        End With

        .HasTitle = True
        .ChartTitle.Text = selectedHeader
        .ClearToMatchStyle
        .ChartStyle = 268
    End With
End Sub