Sub CleanUp()
Application.ScreenUpdating = False
Dim wrkBook As String
wrkBook = ActiveSheet.name
Dim MaxValRange, MaxVal
 
Set MaxValRange = Range("C:C")
MaxVal = Application.WorksheetFunction.Max(MaxValRange)
With MaxValRange
Dim C1, BegAdd
Dim BegCell
Dim BegValue, nextValue
Dim XBeg
Dim colCount As Integer
'Dim colCount
Dim CAve As Double
Dim CStdDev As Double
 
Dim BegCellY() As String
Dim EndCell() As String
Dim ValuesString() As String
'Count the number of columns in the worksheet
colCount = (Worksheets(wrkBook).UsedRange.Columns.count) - 2
ReDim BegCellY(1 To colCount) As String
ReDim EndCell(1 To colCount) As String
ReDim ValuesString(1 To colCount) As String
'C and BegAdd has the third column
Set C1 = .Find(MaxVal, LookIn:=xlValues)
BegAdd = C1.Address
'Finding BegCell
Range(C1.Address).Select
Range("A" & ActiveCell.Row).Select
'ActiveCell now is in first column
BegValue = ActiveCell.Value
'Moving up, finding the BegCell for the same date as in first column
Do
ActiveCell.Offset(-1, 0).Select
nextValue = ActiveCell.Value
'Deleting Empty Rows Can be copied to another sheet ////\\\??
For i = 1 To colCount
    If (ActiveCell.Offset(0, 1 + i).Value = 0 Or ActiveCell.Offset(0, 1 + i).Value = "?" Or ActiveCell.Offset(0, 1 + i).Value = "<>") Then
        ActiveCell.Rows.EntireRow.Delete
    End If
Next i
Loop While (nextValue = BegValue)
'BegCell has the first value in second Column
ActiveCell.Offset(1, 1).Select
BegCell = ActiveCell.Address
BegCellY(1) = ActiveCell.Offset(0, 1).Address '////\\\
'Finding EndCell
Range(C1.Address).Select '' This is where the problem arise.
Range("A" & ActiveCell.Row).Select
'ActiveCell now is in first column
BegValue = ActiveCell.Value
'Moving down, finding the EndCell for the same date as in first column
Do
ActiveCell.Offset(1, 0).Select
nextValue = ActiveCell.Value
'Deleting Empty Rows Can be copied to another sheet ////\\\
For i = 1 To colCount
    If (ActiveCell.Offset(0, 1 + i).Value = 0 Or ActiveCell.Offset(0, 1 + i).Value = "?" Or ActiveCell.Offset(0, 1 + i).Value = "<>") Then
        ActiveCell.Rows.EntireRow.Delete
    End If
Next i
Loop While (nextValue = BegValue)
ActiveCell.Offset(-1, 1).Select
EndCell(1) = ActiveCell.Offset(0, 1).Address '////\\\\
'Storing end value of X values
XBeg = ActiveCell.Address
For i = 1 To (colCount - 1)
    Range(BegCellY(i)).Offset(0, 1).Select
    BegCellY(i + 1) = ActiveCell.Address
 
    Range(EndCell(i)).Offset(0, 1).Select
    EndCell(i + 1) = ActiveCell.Address
Next i
Dim XValuesString As String
XValuesString = BegCell & ":" & XBeg
 
    Sheets.Add After:=Sheets(Sheets.count)
    ActiveSheet.Shapes.AddChart.Select
    ActiveSheet.name = wrkBook & " Chart"
    ActiveChart.ChartType = xlLine
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(1).XValues = Sheets(wrkBook).Range(XValuesString)
 
 
For i = 1 To (colCount)
    ActiveChart.SeriesCollection.NewSeries
    ValuesString(i) = BegCellY(i) & ":" & EndCell(i)
    ActiveChart.SeriesCollection(i).name = i
    ActiveChart.SeriesCollection(i).Values = Sheets(wrkBook).Range(ValuesString(i))
Next i
 
    'Resize the chart
    With ActiveChart.Parent
        .Height = 500 ' resize
        .Width = 750 ' resize
        .Top = 100 ' reposition
        .Left = 100 ' reposition
    End With
    'Setting X and Y axis
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Temperature Vs Time"
        .Legend.Position = xlLegendPositionBottom
 
 
        'X axis
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (Hrs)"
        .Axes(xlCategory).TickLabels.NumberFormat = "h;@"
        .Axes(xlCategory).TickLabelSpacing = "60"
 
 
        'Y axis
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Temperature (deg F)"
        .Axes(xlValue).TickLabels.NumberFormat = "0.0"
 
    End With
End With
Application.ScreenUpdating = True
End Sub
 
' I call above Sub from the code below
 
Sub CallSheets()
Dim aSheet As Integer
Dim count
Dim name As String
count = ActiveWorkbook.Sheets.count
Sheets(1).Select
For aSheet = 1 To count
    Call CleanUp
 
    name = Sheets(aSheet + 1).name
    Sheets(name).Select
Next aSheet
    'Call MaxValues
End Sub