Shrink and improve ActiveSheet Chart Objects code

[Dragondude]

Hi all,

This is my first post here and I have only be playing with code for a week so be gentle.

I have manage to create a monster. I have 28 buttons for 28 pieces of equipment. I have 31 specifications that need to be displayed in 31 line charts for each piece of equipment. As you can imagine a little bit of typing and glad I know how to cut and paste.

The code works. Each button calls a macro and changes the colour of the button so you know which one is selected. I won't bable on anymore and will post the code.

Sub MacroDG1()
'
' MacroDG1 Macro
'

'
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A8:U8")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A9:U9")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 3").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A11:U11")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
  
    ActiveSheet.ChartObjects("Chart 4").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A12:U12")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 5").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A13:U13")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 6").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A14:U14")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 7").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A15:U15")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 8").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A17:U17")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 9").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A23:U23")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 10").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A28:U28")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 11").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A29:U29")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 12").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A30:U30")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
        
    ActiveSheet.ChartObjects("Chart 13").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A31:U31")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
        
    ActiveSheet.ChartObjects("Chart 14").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A32:U32")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
        
    ActiveSheet.ChartObjects("Chart 15").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A33:U33")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
        
    ActiveSheet.ChartObjects("Chart 16").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A34:U34")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"

    ActiveSheet.ChartObjects("Chart 17").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A35:U35")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 18").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A36:U36")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 19").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A37:U37")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 20").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A39:U39")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 21").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A40:U40")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 22").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A41:U41")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 23").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A44:U44")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 24").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A45:U45")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 25").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A46:U46")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
        
    ActiveSheet.ChartObjects("Chart 26").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A47:U47")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
        
    ActiveSheet.ChartObjects("Chart 27").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A48:U48")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
        
    ActiveSheet.ChartObjects("Chart 28").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A49:U49")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
        
    ActiveSheet.ChartObjects("Chart 29").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A57:U57")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"

    ActiveSheet.ChartObjects("Chart 30").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A58:U58")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
    
    ActiveSheet.ChartObjects("Chart 31").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SetSourceData Source:=Sheets("DG # 1").Range("A59:U59")
    ActiveChart.SeriesCollection(1).XValues = "='DG # 1'!$B$2:$U$2"
                
End Sub

This one of the 28 macros dumping data from sheet DG # 1 into each chart.

Private Sub CommandButton2_Click()
    Call MacroDG1
    ActiveSheet.CommandButton1.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton2.BackColor = &H80000010     'dark grey
    ActiveSheet.CommandButton3.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton4.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton5.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton6.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton7.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton8.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton9.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton10.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton11.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton12.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton13.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton14.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton15.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton16.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton17.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton18.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton19.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton20.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton21.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton22.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton23.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton24.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton25.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton26.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton27.BackColor = &H8000000F     'grey
    ActiveSheet.CommandButton28.BackColor = &H8000000F     'grey
End Sub

This is the code that calls a macro and changes the colour of the buttons

This where the fun starts. In the range comments below the cells U8 and U$2 may be different for each piece of equipment, It is determined by the number of test sample taken/recorded. So the "U" may be an "M" or a "K" but for each of the 31 specs it will be the same.

Range("A8:U8") (This cell location range has data in it.)

"='DG # 1'!$B$2:$U$2" (This cell location range has dates in it. Possibly you could examine cells B2 to ??2 to see if it contains a date, not sure if this can be done, as soon as a cell doesn't have a date go back one and use it. This cell letter would also need to be applied to the data range as well.)

Is there a way I can do an If/Case type of look up? At the moment this sort of thing is way above me so any help would be greatly appreciated.

[mjr veverka]

Hi,
Too many words and not enough explicitly expectations.
Give us some sample data file - they do not have to be real.
At the moment, by looking at your codes, you can shorten them somewhat, e.g.:

"CommandButton2_Click":

Option Explicit

Private Sub CommandButton2_Click()
    Dim i As Integer, bck_clr
    
    Call MacroDG1
    
    With ActiveSheet
        For i = 1 To 28
            If i <> 2 Then bck_clr = &H8000000F Else bck_clr = &H80000010
            .OLEObjects("CommandButton" & i).Object.BackColor = bck_clr
        Next
        ActiveCell.Select
    End With
End Sub

"MacroDG1":

Option Explicit

Sub MacroDG1()
    Dim i As Long, indx As Long
    Dim rng, rfrnce As String
    
    rng = Array("A8:U8", "A9:U9", "A11:U11", "A12:U12", "A13:U13", "A14:U14", "A15:U15", "A17:U17", "A23:U23", "A28:U28", _
                "A29:U29", "A30:U30", "A31:U31", "A32:U32", "A33:U33", "A34:U34", "A35:U35", "A36:U36", "A37:U37", "A39:U39", _
                "A40:U40", "A41:U41", "A44:U44", "A45:U45", "A46:U46", "A47:U47", "A48:U48", "A49:U49", "A57:U57", "A58:U58", _
                "A59:U59")
    
    indx = UBound(rng)
    rfrnce = "='DG # 1'!$B$2:$U$2"
    
    With ActiveSheet
        For i = 0 To indx
            With .ChartObjects("Chart " & i + 1).Chart
                .SetSourceData Source:=ThisWorkbook.Sheets("DG # 1").Range(rng(i))
                .SeriesCollection(1).XValues = rfrnce
            End With
        Next
    End With
End Sub

[Dragondude]

Thank you for you quick and amazing reply. Below is a sample of the data.


B2 C2 D2 E2 ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------U2

3-Jan-14 18-Jan-14 15-Mar-14 1-Oct-14 6-Nov-14 12-Feb-15 16-Jun-15 4-Sep-15 9-May-16 10-Jun-16 21-Sep-16 26-Jan-17 28-Apr-17 17-May-17 1-Aug-17 22-Nov-17 28-Feb-18 24-May-18 31-May-18 24-Sep-18


A28 B28 C28 D28 E28 --------------------------------------------------------------------------------------U28
Fe - Iron (alarm =60) 6 6 7 3 2 4 5 3 7.9 2.8 10 7.5 6.5 5.9 6.4 4.8 4.2 6.5 6.3 2.4


I shall add some more info later, I have to race off and do some work.

Thanks again

[Dragondude]

porucha vevrku, Thank you. The first part worked perfectly.

The second part needed a small mod as highlighted.

Also I need to sort out my date detection problem and it will be perfect.

[mjr veverka]

The second part needed a small mod as highlighted.

Yes, my mistake ... change 'MacroDG1' as below:

    With ActiveSheet
        For i = 0 To indx
            With .ChartObjects("Chart " & i + 1).Chart
                .SetSourceData Source:=ThisWorkbook.Sheets("DG # 1").Range(rng(i))
                .SeriesCollection(1).XValues = rfrnce
            End With
        Next
    End With

The first entry in "rng" array variable has index = 0, not 1, or change:

ThisWorkbook.Sheets("DG # 1").Range(rng(i))

to

ThisWorkbook.Sheets("DG # 1").Range(rng(i - 1))

if you use:

For i = 1 To indx

EDIT ... :

... Also I need to sort out my date detection problem ...

e.g. if in cell 'A2' is "3-Jan-14", then:

Option Explicit

Sub date_detection_sample()
    Const strSepar$ = "-"
    Dim cellStrng As String
    Dim uni_var, stryear, strmonth, strday
    
    uni_var = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    
    cellStrng = Trim(Range("a2").Value)                                 '"3-Jan-14"
    stryear = CInt("20" & Trim(Split(cellStrng, strSepar, -1, 1)(2)))   'Year
    strmonth = Trim(Split(cellStrng, strSepar, -1, 1)(1))               'Month
    strmonth = CInt(Application.Match(strmonth, uni_var, 0))            'Month
    strday = CInt(Trim(Split(cellStrng, strSepar, -1, 1)(0)))           'Day
    
    uni_var = DateSerial(stryear, strmonth, strday)                     'Date
    Range("a2").Offset(0, 1).Value = Format(uni_var, "mm-dd-yyyy")      'Formatted date
End Sub

or search the Forum for similar threads, for example: https://www.excelforum.com/excel-pro...rmal-date.html

and on other websites, especially solutions for your geographical location (various systems for recording dates in the system).

[Dragondude]

porucha vevrku,

e.g. if in cell 'A2' is "3-Jan-14", then:

Option Explicit

Sub date_detection_sample()
    Const strSepar$ = "-"
    Dim cellStrng As String
    Dim uni_var, stryear, strmonth, strday
    
    uni_var = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    
    cellStrng = Trim(Range("a2").Value)                                 '"3-Jan-14"
    stryear = CInt("20" & Trim(Split(cellStrng, strSepar, -1, 1)(2)))   'Year
    strmonth = Trim(Split(cellStrng, strSepar, -1, 1)(1))               'Month
    strmonth = CInt(Application.Match(strmonth, uni_var, 0))            'Month
    strday = CInt(Trim(Split(cellStrng, strSepar, -1, 1)(0)))           'Day
    
    uni_var = DateSerial(stryear, strmonth, strday)                     'Date
    Range("a2").Offset(0, 1).Value = Format(uni_var, "mm-dd-yyyy")      'Formatted date
End Sub

I am not 100% sure what you are trying to do above. Obviously it detects the date but it looks like you are reformatting it. If so thats not what I am after. I will try and explain it a bit better.

I need to inspect cell "B2", IF it contains a date THEN I need to increment "B2" to "C2" and inspect that cell for a date. This is to continue until a cell. eg. "U2", does not contain a date. Then I need to replace the "U" in the rng = array statement in the macro with a "T" as it was the last cell that contained a date.

I hope that makes sense.

[Dragondude]

Just curious, what does the term "Option Explicit" mean?

Now, is there a way to detect a date in a cell? They are formatted as date cells but I can't seem to find a way of detecting if the cell contains a date. Can I do a compare of some sort that looks for a pattern like x-xxx-xx or xx-xxx-xx and if the contents match this pattern then it must be a date.

[jeffreybrown]

what does the term "Option Explicit" mean?

This might help...

http://www.cpearson.com/excel/DeclaringVariables.aspx

[Dragondude]

Thanks Jeff, makes sense.

[Dragondude]

I have come up with this bit of code to detect the lack of a date in a cell.

Option Explicit
Sub Inc_test()

Dim i As Long

    i = 2
        For i = 2 To 40
            If Year((Cells(2, i))) = Error(2015) Then
                i = i - 1
                Exit Sub
            Else
               MsgBox i
            End If
        Next
End Sub

Problem is when it actually detects no date the

If Year((Cells(2, i))) = Error(2015) Then

statement says "Type mismatch error"

[mjr veverka]

... is there a way to detect a date in a cell?
They are formatted as date ... but ... a way of detecting if the cell contains a date.
... compare ... that looks for a pattern like x-xxx-xx or xx-xxx-xx ...

... code to detect the lack of a date in a cell ...

I don't understand, you wrote that you have dates (on the sheet) in the format "9-May-16" (x-xxx-xx, other matter, what is here a year and what a day ?). I assume that it is actually a date format, not a text format (because then you can use the macro I placed above, i.e. "date_detection_sample" in which you must indicate which item is a year/month/day).
When it comes to dates, you have a few functions (inter alia: DateValue, DateSerial, IsDate, CDate(), Date, etc.) to choose from, but each/most of them is based on the fact that the given data is as clear as possible, and that there will not be a situation when we find format like "15-Mar-" or "15-Mar", without the year, etc., or "empty string", i.e. empty cell.

Does the phrase "lack of a date in a cell" mean that some cells are empty or in a different format ?

... Problem is when it actually detects no date ... the ... statement says "Type mismatch error"

Try:

Option Explicit

Sub Inc_test()
    Dim c As Integer, cols As Integer, indx As Long, arr()
    indx = 0
    cols = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 2 To cols
        If Not IsDate(Cells(2, c).Value) Then
            indx = indx + 1
            ReDim Preserve arr(1 To indx)
            arr(indx) = Cells(2, c).Address(0, 0) & Chr(9) & "- " & TypeName(Cells(2, c).Value)
        End If
    Next
    MsgBox "The following cells don't contain a date:" & vbCrLf & Join(arr, vbCrLf)
    Erase arr
End Sub

[Dragondude]

I think you are missunderstanding what I am looking for. I don't care what day, month or year it is but just the fact that it IS a date.

What I have is a row that contains dates. I don't care what the date is. For example I might have 10 dates from column B to column K. I might also add more columns with dates so I need to automatically dectect this. The code I wrote, using the YEAR function seems to work and detects the years perfectly, but when I inspect column L for a date and find it does not contain a date the code fails and tells me there is a type mismatch. This is the bit I don't understand.

[mjr veverka]

"Something" that is not a date does not contain its recognizable elements, hence the error ... so, you have 'IsDate()' function as in example above:

If Not IsDate(Cells(2, c).Value) Then

You can add additionally:

If Trim(Cells(2, c).Value) = "" Then

, e.g.:

Sub Inc_test()
    Dim c As Integer, cols As Integer
    
    cols = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 2 To cols
        If Trim(Cells(2, c).Value) = "" Or Not IsDate(Cells(2, c).Value) Then
            '... commands, e.g. MsgBox "Not a date", etc.
        End If
    Next
End Sub

or use the error trap:

    On Error Resume Next
    strYear = Year(Cells(2, i).Value)
    If Err.Number <> 0 Then MsgBox "An error occured"
    On Error GoTo 0

[Dragondude]

Thank you very much. I have used part of your code as below with a couple of lines added for debug purposes. It does exactly what I wanted it to do to determine the last date cell.

Sub Date_Cell()

Dim c As Integer, cols As Integer
    
    cols = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 2 To cols
        If IsDate(Cells(2, c).Value) Then
        End If
            MsgBox c
        
    Next
            MsgBox "Not a date"
   c = c - 1
            MsgBox c

End Sub

Now the next bit I need help with is replacing the cell reference with the calculated "c" in the above into the code you provided previously below. I assume I have put the Call to the above sub in the right spot.

What I need here is all the references to column U to be replaces with the cell "c". I hope that makes sense.

Sub MacroDG1()
    Dim i As Long, indx As Long, a As Long
    Dim rng, rfrnce$

    Call Date_Cell
    
    rng = Array("A8:U8", "A9:U9", "A11:U11", "A12:U12", "A13:U13", "A14:U14", "A15:U15", "A17:U17", "A23:U23", "A28:U28", _
                "A29:U29", "A30:U30", "A31:U31", "A32:U32", "A33:U33", "A34:U34", "A35:U35", "A36:U36", "A37:U37", "A39:U39", _
                "A40:U40", "A41:U41", "A44:U44", "A45:U45", "A46:U46", "A47:U47", "A48:U48", "A49:U49", "A57:U57", "A58:U58", _
                "A59:U59")
    
    indx = UBound(rng)
    rfrnce = "='DG # 1'!$B$2:$U$2"
    
    With ActiveSheet
        For i = 0 To indx
            With .ChartObjects("Chart " & i + 1).Chart
                .SetSourceData Source:=ThisWorkbook.Sheets("DG # 1").Range(rng(i))
                .SeriesCollection(1).XValues = rfrnce
            End With
        Next
    End With
End Sub

[mjr veverka]

Comments (below in the "new" code) to the above code:

Sub Date_Cell()
    Dim c As Integer, cols As Integer
    
    cols = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For c = 2 To cols
        If IsDate(Cells(2, c).Value) Then
            'if any cell is a date, what will you do in this case ?
        Else
            'if any cell is not a date, what will you do in this case ?
        End If
        
        'after the above statement ('If ... Then ... Else ... End If')
        'show message about "c" - in each case, i.e. always, at each turn of the loop
        MsgBox c
    Next
    
    'after the above loop 'For ... Next' always show message: "Not a date"
    MsgBox "Not a date"
    
    'after the above message assign to the variable 'c' the subtraction result 'c - 1'
    c = c - 1
    
    'show message about 'c' - in each case, i.e. always
    MsgBox c
End Sub

... replacing the cell reference, with the calculated "c" in the above, into the code you provided previously below ...
... all the references to column U to be replaces with the cell "c" ...

In addition to the column number (indirectly name), the address must contain the row number.
In the above calculations, 'c' is not an address, but just a column number (2, 3, 4, 5, 6 ... etc.), that does not say "anything" about the row number. Everything takes place within the second row of the sheet, i.e. 'B2', 'C2', 'D2', 'E2', 'F2', etc.:

Cells(2, c).Value

If any address (for substitution) is e.g. "A8:U8", then if we replace "U" in it, we will have "A8:x8", where 'x' = 2, 3, 4, etc.
If we want to replace "U" with a different letter in this address, we must first obtain this letter, based on the column number.
To get it, we have to change/remodel the code above.
When we do this, will the row number ("8"), previously belonging to "U" ("U8"), remain or should it be different ?

[Dragondude]

Thanks for your reply.

No. The row information will not change.

rng = Array("A8:x8", "A9:x9", "A11:x11", "A12:x12", "A13:x13") ' etc

and

rfrnce = "='DG # 1'!$B$2:$x$2"

[Dragondude]

This is what I have gotten so far. It works to the point of providing the correct column letter. I just need to replace the instances in red with the new letter.

Option Explicit
Sub Date_Cell()

Dim c As Integer, cols As Integer
Dim ColumnNumber As Long
Dim ColumnLetter As String

    cols = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 2 To cols
        If IsDate(Cells(2, c).Value) Then
        End If
            ' MsgBox c
        
    Next
            ' MsgBox "Not a date"
               c = c - 1
            ' MsgBox c

  ColumnNumber = c

  ColumnLetter = Split(Cells(2, ColumnNumber).Address, "$")(1) 'Convert To Column Letter
  
  MsgBox "Column " & ColumnNumber & " = Column " & ColumnLetter 'Display Result

End Sub

Sub MacroDG1()

    Dim i As Long, indx As Long, a As Long
    Dim rng, rfrnce$
    
    Worksheets("DG # 1").Activate
    
    Call Date_Cell
    
    Worksheets("Trending Charts").Activate
    
    rng = Array("A8:U8", "A9:U9", "A11:U11", "A12:U12", "A13:U13", "A14:U14", "A15:U15", "A17:U17", "A23:U23", "A28:U28", _
                "A29:U29", "A30:U30", "A31:U31", "A32:U32", "A33:U33", "A34:U34", "A35:U35", "A36:U36", "A37:U37", "A39:U39", _
                "A40:U40", "A41:U41", "A44:U44", "A45:U45", "A46:U46", "A47:U47", "A48:U48", "A49:U49", "A57:U57", "A58:U58", _
                "A59:U59")
    
    indx = UBound(rng)
    rfrnce = "='DG # 1'!$B$2:$U$2"
    
    With ActiveSheet
        For i = 0 To indx
            With .ChartObjects("Chart " & i + 1).Chart
                .SetSourceData Source:=ThisWorkbook.Sheets("DG # 1").Range(rng(i))
                .SeriesCollection(1).XValues = rfrnce
            End With
        Next
    End With
End Sub

[mjr veverka]

I would see it this way:
(the letters of the columns are kept in the array variable and wait for the right moment)

Option Explicit

Sub Date_Cell()
    Dim c As Integer, cols As Integer, indx As Long, arr()
    indx = 0
    cols = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 2 To cols
        If IsDate(Cells(2, c).Value) Then
            indx = indx + 1
            ReDim Preserve arr(1 To indx)
            arr(indx) = Split(Columns(c - 1).Address(1, 0), ":", -1, 1)(0)
        End If
    Next
    MsgBox "Letters of columns with dates:" & vbCrLf & Join(arr, vbCrLf)
    'Erase arr '???
End Sub

Then ... If we had an ideal situation, it would be like this (see image below):
But what will happen if any of the "dates" will not be a date ?
Then how do you change this "U", what value or letter or something else ?
And why "c = c - 1" and not just "c" ?

[Dragondude]

I will answer the second bit first or at least try to.

In your image you have column A. We can ignore this as a date as it only contains the name of the equipment the data in the remaining columns is for and is used as a title for the chart. The way you have layed out the rest of it is correct.

But what will happen if any of the "dates" will not be a date ?

I don't quite understand what you mean. The whole process is to find a cell in a row that doesn't contain a date. This I have achieved thanks to your help. See below.

Then how do you change this "U", what value or letter or something else ?

Exactly. This is the hard bit I think. I have an idea but I am not sure how to apply it.

And why "c = c - 1" and not just "c" ?

The reason I have c = c - 1 is that when I detect the first cell without a date c has already been incremented so I need to go back to the previous cell, the last one with a date.


I am not sure what the following code is doing. Remember noob here.

I would see it this way:
(the letters of the columns are kept in the array variable and wait for the right moment)

Option Explicit

Sub Date_Cell()
    Dim c As Integer, cols As Integer, indx As Long, arr()
    indx = 0
    cols = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 2 To cols
        If IsDate(Cells(2, c).Value) Then
            indx = indx + 1
            ReDim Preserve arr(1 To indx)
            arr(indx) = Split(Columns(c - 1).Address(1, 0), ":", -1, 1)(0)
        End If
    Next
    MsgBox "Letters of columns with dates:" & vbCrLf & Join(arr, vbCrLf)
    'Erase arr '???
End Sub

My idea, if possible, would be to change the cell references below to row/column numbers then replace the U with a variable. Is that possible?

rng = Array("A8:U8", "A9:U9", "A11:U11", "A12:U12", "A13:U13", "A14:U14", "A15:U15", "A17:U17", "A23:U23", "A28:U28", _
                "A29:U29", "A30:U30", "A31:U31", "A32:U32", "A33:U33", "A34:U34", "A35:U35", "A36:U36", "A37:U37", "A39:U39", _
                "A40:U40", "A41:U41", "A44:U44", "A45:U45", "A46:U46", "A47:U47", "A48:U48", "A49:U49", "A57:U57", "A58:U58", _
                "A59:U59")

[mjr veverka]

Give an example with the expected replacement result.

[Dragondude]

All the following "x"s would be K instead of U.

rng = Array("A8:x8", "A9:x9", "A11:x11", "A12:x12", "A13:x13") ' etc

rfrnce = "='DG # 1'!$B$2:$x$2"

[mjr veverka]

try:

Option Explicit

Sub b_replacing_dates()
    Dim c As Integer, cols As Integer, lttr As String
    cols = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 2 To cols
        If Not IsDate(Cells(2, c).Value) Then
            lttr = Split(Columns(c - 1).Address(1, 0), ":", -1, 1)(0)
            Call c_MacroDG1(lttr)
        End If
    Next
End Sub

Sub c_MacroDG1(lttr As String)
    Dim rRng, rfrnce As String
    
    rRng = "A8:U8;A9:U9;A11:U11;A12:U12;A13:U13;A14:U14;A15:U15;A17:U17;A23:U23;A28:U28;A29:U29;A30:U30;A31:U31;A32:U32;A33:U33;A34:U34;A35:U35;A36:U36;A37:U37;A39:U39;A40:U40;A41:U41;A44:U44;A45:U45;A46:U46;A47:U47;A48:U48;A49:U49;A57:U57;A58:U58;A59:U59"
    rRng = Replace(rRng, "U", lttr, 1, -1, 1)
    rRng = Split(rRng, ";", -1, 1)
    MsgBox "'U' in 'rRng' variable => something in 'lttr' variable:" & vbCrLf & vbCrLf & Join(rRng, vbCrLf)
    
    rfrnce = "='DG # 1'!$B$2:$U$2"
    rfrnce = Replace(rfrnce, "U", lttr, 1, -1, 1)
    MsgBox "'U' in 'rfrnce' variable => something in 'lttr' variable:" & vbCrLf & vbCrLf & rfrnce
End Sub

What if a lot of cells in a row (one by one) will not have a date ?

[Dragondude]

Could you please explain what these lines are doing. In particular the 1, -1, 1

rRng = Replace(rRng, "U", lttr, 1, -1, 1)
rRng = Split(rRng, ";", -1, 1)

[Dragondude]

Thank you for your response.

I "think" I know what that is doing. I might have to study it a bit.

With regards to your question there will never be an instance where there will be cells within the range of cells that won't have a date.

Also you have named the subs b_??? and c_???? are these subs within the original sub?

[mjr veverka]

Ad 1 "what these lines are doing"
rRng = 'Replace' - replacement of the "U" character from the variable 'rRng' with the content of the variable 'lttr'
rRng = 'Split' - creation of elements of array variable from the text content of the 'rRng' variable

Briefly: befor 'Replace', the 'rRng' variable contains a text, and after 'Split' it contains an array of elements

Ad 2 "In particular the 1, -1, 1"

e.g. the 'Replace' function - Mark/select its name or place the cursor within its name and press 'F1', get acquainted with the syntax of the function

[Dragondude]

Hi Porucha,

Sorry I haven't gotten back sooner but been away for Xmas.

Sub b_replacing_dates()
    Dim c As Integer, cols As Integer, lttr As String
    cols = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 2 To cols
        If Not IsDate(Cells(2, c).Value) Then
            lttr = Split(Columns(c - 1).Address(1, 0), ":", -1, 1)(0)
            Call c_MacroDG1(lttr)
        End If
    Next
End Sub

The red section never runs. The rest of it seems to run ok but when it detects the non date cell it ends and returns to the code that called it.

[mjr veverka]

How can I know what data you have in the sheet ?
And in which row is data really located (first, second, third, etc.) ?
e.g.: "If Not IsDate(Cells(2, c).Value) Then" = > second row

[Dragondude]

The data I am concerned with is in the second row. The first column contains the word "Date" and the rest of the row contains dates up to the cell that is empty.

If Not IsDate(Cells(2, c).Value) Then

This line works and loops for the required number of times until it encounters the cell with no date. But it never steps into

lttr = Split(Columns(c - 1).Address(1, 0), ":", -1, 1)(0)
Call c_MacroDG1(lttr)

It just steps to End Sub. I can not see why? I thought that if the IF statement was false then it should step into the next line after THEN.

[mjr veverka]

Attach an example.

[Dragondude]

Please see attached file. I hope it has uploaded correctly.

[mjr veverka]

The file is damaged - copy the data sheet to the csv file and attach it again.

[Dragondude]

Try this one.

[mjr veverka]

?
All cells in the "B2:U2" range (after import csv) have dates and every entries has been converted to date format.
In this area, there are no empty cells or entries that are not dates.
?

[Dragondude]

Porucha, Would you please be able to continue with your help on this code. You have done a fantastic job so far and I am at my last hurdle. I ju7st need this last bit sorted out and I don't have the skill to go this next step.

[Dragondude]

But when the code searches in cel B2:V2 it won't find a date. It is at this point I need to replace B2:x2 with U. If at a later date I add more columns with more results and hence more dates I may need to replace the x with Z. I am not looking for gaps between the dates as there won't be any. Does that make sense?

[Dragondude]

Come on guys. It is so close to being right. You have been awesome so far, just need to top it off with a gold medal.

[Dragondude]

Bumpity bump

[Dragondude]

Anyone?????