VBA: Overflow error? - excel

My code is designed to test each agent (turtle) with its respective agent (ninjaturtle). It checks for three parameters. However, I keep getting an overflow error. I have converted my d1 and d2 to Long, Int, Variant, but I still keep getting the error. I even tried using cLng, cdbl, etc. but still nothing. The error is found on d2 with the value of 330.552970855757.
The error is thrown in the d2 = ((Cells(amount * (time - 1) + ninjaturtle + 1, 1).Value)) statement.
Sub assesser()
Dim time As Integer
Dim turtle As Integer
Dim ninjaturtle As Integer
Dim amount As Integer
Dim d1 As Variant
Dim d2 As Variant
amount = 20
Columns(15).Clear
Cells(1, 15).Value = "Flock"
For time = 1000 To 2000
For turtle = 1 To 20
For ninjaturtle = 1 To 20
d1 = (Cells(amount * (time - 1) + turtle + 1, 1).Value)
d2 = ((Cells(amount * (time - 1) + ninjaturtle + 1, 1).Value))
If (Abs(d1 - d2) < 15 _
Or Abs(d1 - d2) > 345) _
And Abs(d1 - d2) < 10 _
And Abs(d1 - d2) < 10 _
Then If IsEmpty(Cells(amount * (time - 1) + turtle + 1, 15).Value) = True Then Cells(amount * (time - 1) + turtle + 1, 15).Value = CStr(Cells(amount * (time - 1) + turtle + 1, 15)) + " " + CStr(Cells(amount * (time - 1) + ninjaturtle + 1, 5)) _
Else Cells(amount * (time - 1) + turtle + 1, 15).Value = CStr(Cells(amount * (time - 1) + turtle + 1, 15)) + ", " + CStr(Cells(amount * (time - 1) + ninjaturtle + 1, 5))
Next ninjaturtle
Next turtle
Next time
Debug.Print (d1)
Debug.Print (d2)
End Sub

Related

Write Excel formula into cell using VBA

I am trying to overwrite wrong Excel formula.
I copied the formula from the cell into the code and placed double quotes.
Already read that I have to type two times " for getting a " into the formula. I can't tell what is really going on, because of companies compliance but the code should do it.
Imagine there are 180 components with the same 18 function in cells. By deleting some components I lost the reference and instead of writing every formula again, I try to do this with VBA.
Sub nachtrag()
Dim i As Integer
Dim j As Integer
Dim Start As Integer
Start = 4
Dim Bezug As Integer
For i = 0 To 179
Bezug = Worksheets("QK-Daten").Range("R" & ((i * 18) + 18) + Start).Value
For j = 1 To 17
Worksheets("QK-Daten").Range("Z" & j + (i * 18) + Start).Value = "=WENN(R" & Bezug & "="""";"""";SVERWEIS(R" & Bezug & ";'QK-Tabelle'!$B$3:$C$123;2;FALSCH))*(R" & j + (i * 18) + Start & "/R" & Bezug & ")+((N" & j + (i * 18) + Start & "+O" & j + (i * 18) + Start & ")*0,3+(P" & j + (i * 18) + Start & "+Q" & j + (i * 18) + Start & ")*0,1)"
Next j
Worksheets("QK-Daten").Range("z" & ((i * 18) + 18) + Start).Copy
Worksheets("QK-Daten").Range("z" & ((i * 18) + 18) + Start).PasteSpecial Paste:=xlValues
Next i
End Sub

Try writing the formula with placeholders in the string and then use Replace() to substitute the values.
Option Explicit
Sub nachtrag()
Dim ws As Worksheet, cell As Range, s As String
Dim Bezug As Long, Start As Long
Dim i As Long, j As Long, r As Long
' formula
Const F = "=IF(R<bezug>="""";"""";VLOOKUP(R<bezug>;'QK-Tabelle'!$B$3:$C$123;2;FALSE))" & _
"*(R<r>/R<bezug>)+((N<r>+O<r>)*0,3+(P<r>+Q<r>)*0,1)"
Start = 4
Set ws = Worksheets("QK-Daten")
With ws
Set cell = .Range("R" & Start)
For i = 0 To 179
Bezug = cell.Offset(18).Row 'Value
For j = 1 To 17
r = j + (i * 18) + Start
s = Replace(F, "<bezug>", Bezug)
s = Replace(s, "<r>", r)
cell.Offset(j, 8).Formula = s 'Z
Next j
' not sure what this is doing
' .Range("z" & ((i * 18) + 18) + Start).Copy
' .Range("z" & ((i * 18) + 18) + Start).PasteSpecial Paste:=xlValues
cell.Offset(18, 8).Value = cell.Offset(18, 8).Value
' next component
Set cell = cell.Offset(18)
Next i
End With
MsgBox "Done", vbInformation
End Sub

Outputting a graph in VBA based off an inputted range

I'm trying to get my VBA code to output a graph in excel based on an inputted range that was selected using a user defined function from multiple cells. I've passed the data to the sub as a range but it ends up assuming that the range is two data sets rather than one data set with x and y values. The data set is selected from excel into a function that is being written separately which then calls the sub.
Sub CreateChart(ByRef r As Range)
Dim cht As Object
Set cht = ActiveSheet.Shapes.AddChart2
cht.Chart.SetSourceData Source:=r
cht.Chart.ChartType = xlXYScatterLines
End Sub
I called the sub through
Call CreateChart(r)
with r being a two column range of data that was selected from excel.
Public Function cubic(ByVal r As Range, x As Double, Optional check As Integer = 1) As Double
The overall function code is here as well
Public Function cubic(ByVal r As Range, x As Double, Optional check As Integer = 1) As Double
Dim data() As Double
Dim check1 As Integer
Dim Smatrix() As Double
Dim Tmatrix() As Double
Dim Xmatrix() As Double
Dim Amatrix() As Double
Dim Hmatrix() As Double
Dim m As Integer
Dim i As Integer
m = r.Rows.Count
ReDim data(1 To m, 2)
ReDim Smatrix(1 To m, 1 To m)
ReDim Tmatrix(1 To m, 4)
ReDim Xmatrix(1 To m)
ReDim Amatrix(1 To m - 1, 1 To 4)
ReDim Hmatrix(1 To m)
check1 = Test(check)
For i = 1 To m
data(i, 1) = r(i, 1).Value
data(i, 2) = r(i, 2).Value
Next i
Smatrix(1, 1) = 1
Smatrix(m, m) = 1
For i = 1 To m - 1
Hmatrix(i) = data(i + 1, 1) - data(i, 1)
Next i
If check1 = 2 Then
Smatrix(1, 2) = -1
Smatrix(m, m - 1) = -1
End If
For i = 2 To m - 1
Smatrix(i, i - 1) = Hmatrix(i - 1)
Smatrix(i, i + 1) = Hmatrix(i)
Smatrix(i, i) = 2 * (Hmatrix(i - 1) + Hmatrix(i))
Next i
For i = 2 To m - 1
Tmatrix(i, 4) = 6 * ((data(i + 1, 2) - data(i, 2)) / Hmatrix(i) - (data(i, 2) - data(i - 1, 2)) / Hmatrix(i - 1))
Next i
For i = 1 To m
If i <> 1 Then
Tmatrix(i, 1) = Smatrix(i, i - 1)
End If
Tmatrix(i, 2) = Smatrix(i, i)
If i <> m Then
Tmatrix(i, 3) = Smatrix(i, i + 1)
End If
Next i
For i = 2 To m
Tmatrix(i, 1) = Tmatrix(i, 1) / Tmatrix(i - 1, 2)
Tmatrix(i, 2) = Tmatrix(i, 2) - Tmatrix(i, 1) * Tmatrix(i - 1, 3)
Tmatrix(i, 4) = Tmatrix(i, 4) - Tmatrix(i, 1) * Tmatrix(i - 1, 4)
Next i
Xmatrix(m) = Tmatrix(m, 4) / Tmatrix(m, 2)
For i = m - 1 To 1 Step -1
Xmatrix(i) = (Tmatrix(i, 4) - Tmatrix(i, 3) * Xmatrix(i + 1)) / Tmatrix(i, 2)
Next i
For i = 1 To m - 1
Amatrix(i, 1) = (Xmatrix(i + 1) - Xmatrix(i)) / 6 * Hmatrix(i)
Amatrix(i, 2) = Xmatrix(i) / 2
Amatrix(i, 3) = (data(i + 1, 2) - data(i, 2)) / Hmatrix(i) - Hmatrix(i) * Xmatrix(i) / 2 - Hmatrix(i) * (Xmatrix(i + 1) - Xmatrix(i)) / 6
Amatrix(i, 4) = data(i, 2)
Next i
If x < data(1, 1) Or x > data(m, 1) Then
Call Check2(x)
If x < data(1, 1) Then
cubic = Amatrix(1, 1) * (x - data(1, 1)) ^ 3 + Amatrix(1, 2) * (x - data(1, 1)) ^ 2 + Amatrix(1, 3) * (x - data(1, 1)) + Amatrix(1, 4)
ElseIf x > data(m, 1) Then
cubic = Amatrix(m - 1, 1) * (x - data(m - 1, 1)) ^ 3 + Amatrix(m - 1, 2) * (x - data(m - 1, 1)) ^ 2 + Amatrix(m - 1, 3) * (x - data(m - 1, 1)) + Amatrix(m - 1, 4)
End If
ElseIf x = data(m, 1) Then
cubic = data(m, 2)
Else
For i = 1 To m - 1
If data(i, 1) < x And x < data(i + 1, 1) Then
cubic = Amatrix(i, 1) * (x - data(i, 1)) ^ 3 + Amatrix(i, 2) * (x - data(i, 1)) ^ 2 + Amatrix(i, 3) * (x - data(i, 1)) + Amatrix(i, 4)
ElseIf x = data(i, 1) Then
cubic = data(i, 2)
End If
Next i
End If
Call CreateChart(r)
End Function
As well as the subroutine and function called within the function that haven't been posted
Public Function Test(check As Integer) As Integer
Dim Response As Integer
If check = 1 Then
Response = MsgBox("Boundary Condition 1 selected, is this correct (select No for boundary condition 2)?", vbYesNo, "Boundary Conditions")
If Response = 6 Then
Test = 1
Else
Test = 2
End If
ElseIf check = 2 Then
Response = MsgBox("Boundary Condition 2 selected, is this correct (select No for boundary condition 1)?", vbYesNo, "Boundary Conditions")
If Response = 6 Then
Test = 2
Else
Test = 1
End If
Else
Response = MsgBox("Incorrect Boundary Condition, select Yes for condition 1 and No for condition 2", vbYesNo, "Boundary Conditions")
If Response = 6 Then
Test = 1
Else
Test = 2
End If
End If
End Function
Public Sub Check2(x)
MsgBox ("Value given is outside data range, answer may not be correct, extrapolating from calculated polynomial")
End Sub

Try
Sub CreateChart(ByRef r As Range)
Dim cht As Object
Set cht = ActiveSheet.Shapes.AddChart2(XlChartType:=xlXYScatterSmooth)
cht.Chart.SetSourceData Source:=r
End Sub

VBA BS option pricing: why am I getting a compile error?

I'm trying to use this VBA code to price American or European options... But I run into
"Compile error: Can't find project or library"
with dt =T/n highlighted.
I can't determine what is wrong. Hoping someone smarter than I can point out what I'm overlooking.
Function CRRTree(Spot, K, T, rf, vol, n, OpType As String, ExType As String)
dt = T / n
u = Exp(vol * (dt ^ 0.5))
d = 1 / u
p = (Exp(rf * dt) - d) / (u - d)
' Tree for stock price
Dim S() As Double
ReDim S(n + 1, n + 1) As Double
For i = 1 To n + 1
For j = i To n + 1
S(i, j) = Spot * u ^ (j - i) * d ^ (i - 1)
Next j
Next i
' Calculate Terminal Price for Calls and Puts
Dim Op() As Double
ReDim Op(n + 1, n + 1) As Double
For i = 1 To n + 1
Select Case OpType
Case "C": Op(i, n + 1) = Application.Max(S(i, n + 1) - K, 0)
Case "P": Op(i, n + 1) = Application.Max(K - S(i, n + 1), 0)
End Select
Next i
' Calculate Remaining entries for Calls and Puts
For j = n To 1 Step -1
For i = 1 To j
Select Case ExType
Case "A":
If OpType = "C" Then
Op(i, j) = Application.Max(S(i, j) - K, Exp(-rf * dt) * (p * Op(i, j + 1) + (1 - p) * Op(i + 1, j + 1)))
ElseIf OpType = "P" Then
Op(i, j) = Application.Max(K - S(i, j), Exp(-rf * dt) * (p * Op(i, j + 1) + (1 - p) * Op(i + 1, j + 1)))
End If
Case "E":
Op(i, j) = Exp(-rf * dt) * (p * Op(i, j + 1) + (1 - p) * Op(i + 1, j + 1))
End Select
Next i
Next j
CRRTree = Op(1, 1)
End Function

How to write VBA function activating different sheets?

I'm writing a VBA function using an input that determines the sheet containing other inputs.
With different curvename, the function should refer to data in different sheets. My code is as below:
Public Function DFrate(mtmdate As Date, pmtdate As Date, curvename As String, colno As Integer) As Double
Dim yf As Double
Dim noday As Integer
Dim lastrow As Integer
Dim rate As Range
Dim tenor As Range
Dim DFinv As Double
Dim DFinv1 As Double
Dim DFinv2 As Double
noday = pmtdate - mtmdate
yf = noday / 360
MsgBox noday
ThisWorkbook.Sheets("HS_" & curvename).Activate
lastrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
Set rate = ActiveSheet.Range(Cells(102, 3 + colno), Cells(lastrow, 3 + colno))
Set tenor = ActiveSheet.Range(Cells(102, 2), Cells(lastrow, 2))
If (noday <= tenor(1, 1)) Then
DFinv1 = (1 + rate(1, 1) / 100) ^ yf
DFinv2 = (1 + rate(2, 1) / 100) ^ yf
DFinv = DFinv1 + (noday - tenor(1, 1)) * (DFinv2 - DFinv1) / (tenor(2, 1) - tenor(1, 1))
MsgBox DFinv
End If
For k = 1 To lastrow
If (noday > tenor(k, 1) And noday <= tenor(k + 1, 1)) Then
DFinv1 = (1 + rate(k, 1) / 100) ^ (tenor(k, 1) / 360)
DFinv2 = (1 + rate(k + 1, 1) / 100) ^ (tenor(k + 1, 1) / 360)
DFinv = DFinv1 + (noday - tenor(k, 1)) * (DFinv2 - DFinv1) / (tenor(k + 1, 1) - tenor(k, 1))
Exit For
End If
Next k
DFrate = DFinv
End Function
I got the error #NAME?
Even the message box "Msgbox noday" does not work.
Can someone please let me know what should be changed in my code? Thanks!

If I:
put the code below (which is slightly different to yours) in a regular module (not Thisworkbook or any of the Sheet modules),
create a worksheet named "HS_O",
put 5 in cell B102 of worksheet "HS_O", put 3 in cell D102 of worksheet "HS_O"
and put =DFrate(TODAY(),TODAY(),"O",1) in any cell of any worksheet within Thisworkbook
I get a return value of 1. I think it works for me (and should work for you too in theory).
Option Explicit
Public Function DFrate(mtmdate As Date, pmtdate As Date, curvename As String, colno As Long) As Double
Dim yf As Double
Dim noday As Long
Dim lastrow As Long
Dim rate As Range
Dim tenor As Range
Dim DFinv As Double
Dim DFinv1 As Double
Dim DFinv2 As Double
Dim k As Long
noday = pmtdate - mtmdate
yf = noday / 360
' Maybe have a defensive check/guard
' or some return particular return value if sheet doesn't exist
With ThisWorkbook.Sheets("HS_" & curvename)
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rate = .Range(.Cells(102, 3 + colno), .Cells(lastrow, 3 + colno))
Set tenor = .Range(.Cells(102, 2), .Cells(lastrow, 2))
End With
If (noday <= tenor(1, 1)) Then
DFinv1 = (1 + rate(1, 1) / 100) ^ yf
DFinv2 = (1 + rate(2, 1) / 100) ^ yf
DFinv = DFinv1 + (noday - tenor(1, 1)) * (DFinv2 - DFinv1) / (tenor(2, 1) - tenor(1, 1))
MsgBox DFinv
End If
For k = 1 To lastrow
If (noday > tenor(k, 1) And noday <= tenor(k + 1, 1)) Then
DFinv1 = (1 + rate(k, 1) / 100) ^ (tenor(k, 1) / 360)
DFinv2 = (1 + rate(k + 1, 1) / 100) ^ (tenor(k + 1, 1) / 360)
DFinv = DFinv1 + (noday - tenor(k, 1)) * (DFinv2 - DFinv1) / (tenor(k + 1, 1) - tenor(k, 1))
Exit For
End If
Next k
DFrate = DFinv
End Function
I don't deal with calling UDFs from the worksheet much. Maybe merely calling the function activates the sheet the function is on, and not the "HS_" & curvename worksheet. I don't know for sure. Either way, we can use a With statement.

Inefficient excel code breaks after few thousand lines of data

I am fairly new to Excel and VBA. I wrote a code that separates a line of data into multiple sections which then adds headers, colors, and plots.
The problem is when I have many lines of data. My code runs just fine when I have about 4000 lines of data, but I get say about 10000 lines, Excel freezes and does not respond anymore. The code is fairly long and I do expect anyone to read the entire thing.
My doubts are that excel does not respond and crashes because there is a watch-dog timer that times the execution of the code and if it does not receive anything back then it crashes. This is only a guess.
Here is a few lines of the actual data that I need to filter and everything.
2017:06:29T14:12:11,0,1013,00,156,-0.112,12.751,000,000,38,34,33,1014,00,202,-0.102,12.734,000,000,38,35,33,1015,00,174,-0.105,12.755,000,000,37,35,33,1008,00,156,-0.110,12.741,000,000,37,35,33,
2017:06:29T14:12:12,0,1013,00,157,-0.102,12.758,000,000,38,34,33,1014,00,203,-0.105,12.744,000,000,38,35,33,1015,00,175,-0.103,12.757,000,000,37,35,33,1008,00,157,-0.107,12.757,000,000,37,35,33,
2017:06:29T14:12:13,0,1013,00,158,-0.113,12.737,000,000,38,34,33,1014,00,204,-0.094,12.760,000,000,38,35,33,1015,00,176,-0.117,12.748,000,000,37,35,33,1008,00,158,-0.109,12.744,000,000,37,35,33,
2017:06:29T14:12:14,0,1013,00,159,-0.103,12.753,000,000,38,34,33,1014,00,205,-0.103,12.720,000,000,38,35,33,1015,00,177,-0.108,12.732,000,000,37,35,33,1008,00,159,-0.110,12.758,000,000,37,35,33,
2017:06:29T14:12:15,0,1013,00,160,-0.112,12.757,000,000,38,34,33,1014,00,206,-0.095,12.734,000,000,38,35,33,1015,00,178,-0.118,12.729,000,000,37,35,33,1008,00,160,-0.115,12.755,000,000,37,35,33,
I am open to any suggestions and more than happy to learn. Thank you for your time and help in advance.
Sub SeparateData()
'Author: Me
'Date: July 13, 2017
'Purpose: This macro take the data in the worksheet and separates the data in a readable fashion for the user.
' This macro also plots and reports any errors that it has caught both in separate sheets named accordingly.
'Define variables
Dim i As Variant
Dim j As Variant
Dim k As Variant
Dim data As Variant
Dim data2 As Variant
Dim count As Variant
Dim shiftDown As Variant
Dim monitorNum As Variant
Dim errorCount As Variant
Dim battChart As ChartObject
Dim currChart As ChartObject
Dim tempChart As ChartObject
'Stop the alerts so we can erase the sheets peacefully
Application.DisplayAlerts = False
'Erase the extra sheets
Sheets("Sheet2").Delete
Sheets("Sheet3").Delete
'Turn on the alerts in case something else happened
Application.DisplayAlerts = True
'Rename the first sheet
ActiveSheet.Name = "Data"
'Create a new sheet for the plots
Sheets.Add.Name = "Plots"
'Create a new sheet for the errors
Sheets.Add.Name = "Errors"
'Activate the first sheet for data processing
Worksheets("Data").Activate
'Enter the number of monitors
monitorNum = 4
'Variable to shift down the data so that te headers will fit (recommended 2)
shiftDown = 2
'Variable to count the number of errors the program thinks occured
errorCount = 0
'Count how many data point there are in the sheet
count = Cells(1, 1).CurrentRegion.Rows.count
'Iterate through the points separating the Data
For i = 0 To count - 1
'First separate the date from the rest
data = Cells(count - i, 1).Value
data = Split(data, "T")
For j = 0 To UBound(data)
Cells(count - i + shiftDown, j + 1).Value = data(j)
Next j
'Now separate the rest of the data
data2 = data(1)
data2 = Split(data2, ",")
For j = 0 To UBound(data2)
Cells(count - i + shiftDown, j + 2).Value = data2(j)
Next j
For k = 0 To monitorNum - 1
'Check for voltage error
If Cells(count - i + shiftDown, (k * 10) + 8).Value > 20 Or IsNumeric(Cells(count - i + shiftDown, (k * 10) + 8).Value) = False Then
'increment the number of errors found
errorCount = errorCount + 1
'Activate the Errors sheet for error recording
Worksheets("Errors").Activate
'Save the row number and the monitor number where the error was founf
Cells(errorCount, 1).Value = "Voltage error in row"
Cells(errorCount, 2).Value = count - i + shiftDown
Cells(errorCount, 3).Value = "in column"
Cells(errorCount, 4).Value = (k * 10) + 8
Cells(errorCount, 5).Value = "in Monitor"
Cells(errorCount, 6).Value = k + 1
Cells(errorCount, 7).Value = "The recorded data was"
Sheets("Data").Cells(count - i + shiftDown, (k * 10) + 8).Copy Cells(errorCount, 8)
'Autofit all the columns
Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
'Activate the first sheet for data processing
Worksheets("Data").Activate
'Clear the contents of the error
Cells(count - i + shiftDown, (k * 10) + 8).ClearContents
End If
'Check for current error
If Cells(count - i + shiftDown, (k * 10) + 7).Value > 80 Or IsNumeric(Cells(count - i + shiftDown, (k * 10) + 7).Value) = False Then
'increment the number of errors found
errorCount = errorCount + 1
'Activate the Errors sheet for error recording
Worksheets("Errors").Activate
'Save the row number and the monitor number where the error was founf
Cells(errorCount, 1).Value = "Current error in row"
Cells(errorCount, 2).Value = count - i + shiftDown
Cells(errorCount, 3).Value = "in column"
Cells(errorCount, 4).Value = (k * 10) + 7
Cells(errorCount, 5).Value = "in Monitor"
Cells(errorCount, 6).Value = k + 1
Cells(errorCount, 7).Value = "The recorded data was"
Sheets("Data").Cells(count - i + shiftDown, (k * 10) + 7).Copy Cells(errorCount, 8)
'Autofit all the columns
Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
'Activate the first sheet for data processing
Worksheets("Data").Activate
'Clear the contents of the error
Cells(count - i + shiftDown, (k * 10) + 7).ClearContents
End If
'Check for temperature error
If Cells(count - i + shiftDown, (k * 10) + 13).Value > 80 Or IsNumeric(Cells(count - i + shiftDown, (k * 10) + 13).Value) = False Then
'increment the number of errors found
errorCount = errorCount + 1
'Activate the Errors sheet for error recording
Worksheets("Errors").Activate
'Save the row number and the monitor number where the error was founf
Cells(errorCount, 1).Value = "Temperature error in row"
Cells(errorCount, 2).Value = count - i + shiftDown
Cells(errorCount, 3).Value = "in column"
Cells(errorCount, 4).Value = (k * 10) + 13
Cells(errorCount, 5).Value = "in Monitor"
Cells(errorCount, 6).Value = k + 1
Cells(errorCount, 7).Value = "The recorded data was"
Sheets("Data").Cells(count - i + shiftDown, (k * 10) + 13).Copy Cells(errorCount, 8)
'Autofit all the columns
Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
'Activate the first sheet for data processing
Worksheets("Data").Activate
'Clear the contents of the error
Cells(count - i + shiftDown, (k * 10) + 13).ClearContents
End If
Next k
Next i
'Erase the data that has been duplicated
For i = 1 To shiftDown
Cells(i, 1).Value = ""
Next i
'Write and color the headers
'For the Date
Range(Cells(shiftDown - 1, 1), Cells(shiftDown, 1)).Merge
Range(Cells(shiftDown - 1, 1), Cells(shiftDown, 1)).Value = "Date"
Range(Cells(shiftDown - 1, 1), Cells(count + shiftDown, 1)).Interior.Color = RGB(200, 190, 150)
'For the Time
Range(Cells(shiftDown - 1, 2), Cells(shiftDown, 2)).Merge
Range(Cells(shiftDown - 1, 2), Cells(shiftDown, 2)).Value = "Time"
Range(Cells(shiftDown - 1, 2), Cells(count + shiftDown, 2)).Interior.Color = RGB(150, 140, 80)
'For the Key Switch
Range(Cells(shiftDown - 1, 3), Cells(shiftDown, 3)).Merge
Range(Cells(shiftDown - 1, 3), Cells(shiftDown, 3)).Value = "Key Switch"
Range(Cells(shiftDown - 1, 3), Cells(count + shiftDown, 3)).Interior.Color = RGB(200, 200, 0)
For i = 1 To monitorNum
Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Merge
Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Value = "Monitor " & i
'color the headers
If i Mod 4 = 0 Then
Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Interior.Color = RGB(100, 255, 100)
ElseIf i Mod 3 = 0 Then
Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Interior.Color = RGB(255, 100, 10)
ElseIf i Mod 2 = 0 Then
Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Interior.Color = RGB(100, 100, 255)
Else
Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Interior.Color = RGB(255, 75, 75)
End If
Next i
For i = 0 To monitorNum - 1
'Monitor ID
Cells(shiftDown, 1 + (i * 10) + 3).Value = "MONITOR_NUM"
'Monitor status
Cells(shiftDown, 2 + (i * 10) + 3).Value = "MONITOR_STATUS"
'Heart Beat count
Cells(shiftDown, 3 + (i * 10) + 3).Value = "HB_COUNT"
'For Current
Cells(shiftDown, 4 + (i * 10) + 3).Value = "CURRENT"
Range(Cells(shiftDown, 4 + (i * 10) + 3), Cells(count + shiftDown, 4 + (i * 10) + 3)).Interior.Color = RGB(240, 150, 150)
'For Voltage
Cells(shiftDown, 5 + (i * 10) + 3).Value = "VOLTAGE"
Range(Cells(shiftDown, 5 + (i * 10) + 3), Cells(count + shiftDown, 5 + (i * 10) + 3)).Interior.Color = RGB(110, 160, 180)
'State of Charge
Cells(shiftDown, 6 + (i * 10) + 3).Value = "SOC"
'State of Health
Cells(shiftDown, 7 + (i * 10) + 3).Value = "SOH"
'Chip temperature
Cells(shiftDown, 8 + (i * 10) + 3).Value = "TEMP_CHP"
'Internal temperature
Cells(shiftDown, 9 + (i * 10) + 3).Value = "TEMP_INT"
'For Temperature of the terminal
Cells(shiftDown, 10 + (i * 10) + 3).Value = "TEMP_EXT"
Range(Cells(shiftDown, 10 + (i * 10) + 3), Cells(count + shiftDown, 10 + (i * 10) + 3)).Interior.Color = RGB(255, 190, 0)
Next i
'Add borders all around the data
Cells(shiftDown, 1).CurrentRegion.Borders.LineStyle = xlContinuous
'Autofit all the columns
Cells(shiftDown, 1).CurrentRegion.EntireColumn.AutoFit
'Plotting
'Activate the first sheet for data plotting
Worksheets("Data").Activate
'Add a new plot
Set battChart = Sheets("Plots").ChartObjects.Add(0, 0, 1200, 300)
'Plot the battery data
With battChart.Chart
.SetSourceData Source:=Sheets("Data").Range(Cells(5, 8), Cells(count + shiftDown, 8))
.SeriesCollection(1).Name = "Battery 1"
.ChartWizard Title:="Voltage", HasLegend:=True, CategoryTitle:="Time (s)", ValueTitle:="Voltage (V)", Gallery:=xlXYScatterLinesNoMarkers
For i = 2 To monitorNum
.SeriesCollection.NewSeries
.SeriesCollection(i).Values = Sheets("Data").Range(Cells(5, ((i - 1) * 10) + 8), Cells(count + shiftDown, ((i - 1) * 10) + 8))
.SeriesCollection(i).Name = "Battery " & i
Next i
End With
'Add a new plot
Set currChart = Sheets("Plots").ChartObjects.Add(0, 300, 1200, 300)
'Plot the current data
With currChart.Chart
.SetSourceData Source:=Sheets("Data").Range(Cells(5, 7), Cells(count + shiftDown, 7))
.SeriesCollection(1).Name = "Battery 1"
.ChartWizard Title:="Current", HasLegend:=True, CategoryTitle:="Time (s)", ValueTitle:="Current (A)", Gallery:=xlXYScatterLinesNoMarkers
For i = 2 To monitorNum
.SeriesCollection.NewSeries
.SeriesCollection(i).Values = Sheets("Data").Range(Cells(5, ((i - 1) * 10) + 7), Cells(count + shiftDown, ((i - 1) * 10) + 7))
.SeriesCollection(i).Name = "Battery " & i
Next i
End With
'Add a new plot
Set tempChart = Sheets("Plots").ChartObjects.Add(0, 600, 1200, 300)
'Plot the current data
With tempChart.Chart
.SetSourceData Source:=Sheets("Data").Range(Cells(5, 13), Cells(count + shiftDown, 13))
.SeriesCollection(1).Name = "Battery 1"
.ChartWizard Title:="Temperature", HasLegend:=True, CategoryTitle:="Time (s)", ValueTitle:="Temperature (F)", Gallery:=xlXYScatterLinesNoMarkers
For i = 2 To monitorNum
.SeriesCollection.NewSeries
.SeriesCollection(i).Values = Sheets("Data").Range(Cells(5, ((i - 1) * 10) + 13), Cells(count + shiftDown, ((i - 1) * 10) + 13))
.SeriesCollection(i).Name = "Battery " & i
Next i
End With
'Indicate that the macro has finished its job
Beep
MsgBox "Data separation is complete. There were " & errorCount & " errors found."
End Sub

All of your Worksheets("x").Activate are totally unnecessary, are slowing your code significantly and are begging for inexplicable errors later when you forget to activate the correct sheet or your bored user starts clicking around during execution because it's taking too long. Declare some Worksheet variables and work with those.
Dim DataSheet as Worksheet
ActiveSheet.Name = "Data"
Set DataSheet = ActiveSheet
Dim PlotSheet as Worksheet
Set PlotSheet as Worksheets.Add
Plotsheet.Name = "Plots"
Dim ErrorSheet as Worksheet
Set ErrorSheet = Worksheets.Add
ErrorSheet.Name = "Errors"
count = Datasheet.Cells(1, 1).CurrentRegion.Rows.count
'GET RID OF THIS EVERYWHERE!!! Worksheets("Errors").Activate
'Save the row number and the monitor number where the error was founf
With ErrorSheet
.Cells(errorCount, 1).Value = "Voltage error in row"
.Cells(errorCount, 2).Value = count - i + shiftDown
.Cells(errorCount, 3).Value = "in column"
.Cells(errorCount, 4).Value = (k * 10) + 8
.Cells(errorCount, 5).Value = "in Monitor"
.Cells(errorCount, 6).Value = k + 1
.Cells(errorCount, 7).Value = "The recorded data was"
'Note subtle change here:
DataSheet.Cells(count - i + shiftDown, (k * 10) + 8).Copy .Cells(errorCount, 8)
'Note: explicitly setting "datasheet" as the destination and using the "With" to save some typing on the ".Cells" call.
'You could explicitly type the "ErrorSheet" to make it more clear
'an even better version is:
.cells(errorCount, 8) = DataSheet.Cells(count - i + shiftDown, (k * 10) + 8)
End With
Continue to do that everywhere. Future you will appreciate current you...
Every time you're doing a Sheet("x").Activate eliminate that line and explicitly add a reference to the appropriate worksheet variable you declared earlier.
Every time you have an unqualified Sheets or Cells or Range call, make it an explicit reference by prepending the appropriate worksheet variable. Future you will appreciate the fact that you can see exactly what worksheet you're referencing. Sure, there may be some extra typing involved, but that extra typing significantly reduces the chance of inserting very subtle and difficult to find bugs.
Using .Copy is very slow for single cells. It does gain a speed advantage if you're copying large blocks of cells in a single go (somewhere in the neighborhood of 3-5k cells in a single copy statement vs a loop through setting individual cell values).
As Uri Goren pointed out setting Application.Calculation = False will definitely improve your speed. I'd recommend not setting Application.ScreenUpdating = False until after your code is 100% functional and not generating any errors. Once you're at that point, it's a great thing to do.
At this point in your code you may want to add the indicated line:
'Iterate through the points separating the Data
For i = 0 To count - 1
'Add this line:
Application.StatusBar = "Separating points #" & i
Put a similar message just inside the top of each of your large loops. You'll likely see that your code isn't hanging, just taking a long time to process. Plus you'll have an update that your user can watch so (s)he'll know it isn't hung and is still doing something.
At the end of your code put:
Application.StatusBar = ""
To clear the message so you get your normal Excel StatusBar functionality returned.

Add these two lines at the beginning of the subroutine:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
And these 2 lines before the end of the subroutine
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
It should speed up your code significantly

Resources