VBA arrays

[Jameo]

Hi all,

I am cycling through a series of data, and assigning each data item to a specific array based on some critera. After that I am then performing smoe calculations on the data.

My problem is that my code is breaking down when one of the arrays doesn't contain any data.

I have tried to check if the array is filled using various functions,

IsArray(var) only says if the array exists
IsEmpty(var) returns fasle even when the array is empty.

Does anyone have any ideas about what to do?

Here is my code:

Private Sub CreateTable()

Dim AgPres As Long, AsPres As Long, AcPres As Long, DifPres As Long
Dim StDAry() As Double
Dim AsPresAr() As Double
Dim AgPresAr() As Double
Dim LRow As Long
Dim Flows As Long
Dim AgPresCnt As Long
Dim AsPresCnt As Long
Dim AgPresCu As Double, AsPresCu As Double
Dim AbsAsEr As Double
Dim AsArCnt As Long
Dim AsBrCnt As Long
Dim AbsPosErFinal As Double
Dim AbsPosErVal As Double
Dim AbsPosErCnt As Long
Dim AbsNegErFinal As Double
Dim AbsNegErVal As Double
Dim AbsNegErCnt As Long
Dim StDevTotal As Double
Dim StDevCuVal As Double
Dim StDevMean As Double
Dim StDevFinal As Double
Dim AbsAsErFinal As Double
Dim AgArCnt As Long
 

AsPres = 2
AgPres = 3
AcPres = 4
DifPres = 5
Flows = 6
If Not ActiveSheet.Name = "Agreed data" Then
    Sheets("Agreed data").Select
End If

LRow = Range("A" & Rows.Count).End(xlUp).Row
'----------------
'Cycles through values and adds to arrays

For i = 3 To LRow
If Cells(i, Flows).Value <= 0 Then
    GoTo NextI
        Else
            If Not Cells(i, AgPres).Value = 0 Then
                AgPresCnt = AgPresCnt + 1
                ReDim Preserve AgPresAr(1 To AgPresCnt)
                AgPresAr(AgPresCnt) = Cells(i, DifPres).Value
            End If
            
            AsPresCnt = AsPresCnt + 1
            ReDim Preserve AsPresAr(1 To AsPresCnt)
            AsPresAr(AsPresCnt) = Cells(i, DifPres).Value
End If
                        
                
        
NextI:
Next i
'-------
'-------
'-------
 
'Calculates data for all critical OT's
AsArCnt = 0
AsBrCnt = 0
AbsAsEr = 0
AbsPosErVal = 0
AbsPosErCnt = 0
AbsNegErCnt = 0
AbsNegErVal = 0
StDevMean = 0
StDevCuVal = 0
StDevTotal = 0
AbsAsErFinal = 0
AbsNegErFinal = 0
StDevFinal = 0
 
 
Do
    AsArCnt = AsArCnt + 1
    'Calculates breaches
    If AsPresAr(AsArCnt) < 0 Then
        AsBrCnt = AsBrCnt + 1
    End If
    'Calculates AbsEr
    AbsAsEr = AbsAsEr + Sqr(AsPresAr(AsArCnt) ^ 2)
'   Calculates positive error
    If AsPresAr(AsArCnt) > 0 Then
        AbsPosErCnt = AbsPosErCnt + 1
        AbsPosErVal = AbsPosErVal + AsPresAr(AsArCnt)
    End If
    'Calculates Neg error
    If AsPresAr(AsArCnt) < 0 Then
        AbsNegErCnt = AbsNegErCnt + 1
        AbsNegErVal = AbsNegErVal + AsPresAr(AsArCnt)
    End If
    'Calculates Standard Deviation
    StDevMean = Application.WorksheetFunction.Average(AsPresAr)
    StDevCuVal = (AsPresAr(AsArCnt) - StDevMean) ^ 2
    StDevTotal = StDevTotal + StDevCuVal

Loop Until AsArCnt = AsPresCnt
AbsAsErFinal = AbsAsEr / Application.WorksheetFunction.Count(AsPresAr)

If AbsPosErCnt = 0 Then
    AbsPosErFinal = 0
Else
    AbsPosErFinal = AbsPosErVal / AbsPosErCnt
End If
If AbsNegErCnt = 0 Then
    AbsNegErFinal = 0
Else
    AbsNegErFinal = AbsNegErVal / AbsNegErCnt
End If
StDevFinal = Sqr(StDevTotal / (Application.WorksheetFunction.Count(AsPresAr) - 1))

'-------
'-------
'-------
'Calculates Pressure Requests
'Counts number of requests
Dim AgPresReq As Long
Dim AgBrCnt As Long
Dim AbsCuVal As Double, AgAbsTotal As Double, AgAbsFinal As Double
Dim AgPosErCnt As Long, AgPosErTotal As Double, AgPosErFinal As Double
Dim AgNegErCnt As Long, AgNegErTotal As Double, AgNegErFinal As Double
Dim AgStDevMean As Double, AgStDevCuVal As Double, AgStDevTotal As Double, AgStDevFinal As Double
 
AgPresReq = 0
AgBrCnt = 0
AbsCuVal = 0
AgAbsTotal = 0
AgAbsFinal = 0
AgPosErCnt = 0
AgPosErTotal = 0
AgPosErFinal = 0
AgNegErCnt = 0
AgNegErTotal = 0
AgNegErFinal = 0
AgStDevMean = 0
AgStDevCuVal = 0
AgStDevTotal = 0
AgStDevFinal = 0
'If IsEmpty(AgPresAr) Then
  '  AgPresReq = 0
  '  AgBrCnt = 0
  '  AgAbsFinal = 0
 '   AgPosErFinal = 0
  '  AgNegErFinal = 0
 '   AgStDevFinal = 0
'Else
    AgPresReq = Application.WorksheetFunction.Count(AgPresAr)

    Do
        AgArCnt = AgArCnt + 1
        'Counts Breaches
        If AgPresAr(AgArCnt) < 0 Then
            AgBrCnt = AgBrCnt + 1
        End If
        'Abs Error
        AgAbsCuval = Sqr((AgPresAr(AgArCnt)) ^ 2)
        AgAbsTotal = AgAbsTotal + AgAbsCuval
        'PosEr
        If AgPresAr(AgArCnt) > 0 Then
            AgPosErCnt = AgPosErCnt + 1
            AgPosErTotal = AgPosErTotal + AgPresAr(AgArCnt)
        End If
        'NegEr
        If AgPresAr(AgArCnt) < 0 Then
            AgNegErCnt = AgNegErCnt + 1
            AgNegErTotal = AgNegErTotal + AgPresAr(AgArCnt)
        End If

    'Calculates Standard Deviation
    AgStDevMean = Application.WorksheetFunction.Average(AgPresAr)
    AgStDevCuVal = (AgPresAr(AgArCnt) - AgStDevMean) ^ 2
    AgStDevTotal = AgStDevTotal + AgStDevCuVal
 
    Loop Until AgArCnt = AgPresCnt
    If Application.WorksheetFunction.Count(AgPresAr) = 0 Then
        AgAbsFinal = 0
    Else
        AgAbsFinal = AgAbsTotal / Application.WorksheetFunction.Count(AgPresAr)
    End If
    If AgPosErCnt = 0 Then
        AgPosErFinal = 0
    Else
        AgPosErFinal = AgPosErTotal / AgPosErCnt
    End If
    If AgNegErCnt = 0 Then
        AgNegErFinal = 0
    Else
        AgNegErFinal = AgNegErTotal / AgNegErCnt
    End If
    AgStDevFinal = Sqr(AgStDevTotal / (Application.WorksheetFunction.Count(AgPresAr) - 1))
'End If
    Cells(55, 5).Value = StDevFinal
    Dim sht As Worksheet
    Set sht = Sheets("ControlPage")
 

    IntCol = 2
'''Enter VAlues in Table!!!!!!!!
sht.Cells(2, IntCol).Value = AsBrCnt
sht.Cells(3, IntCol).Value = AbsAsErFinal
sht.Cells(4, IntCol).Value = AbsPosErFinal
sht.Cells(5, IntCol).Value = AbsNegErFinal
sht.Cells(6, IntCol).Value = StDevFinal

sht.Cells(9, IntCol).Value = AgPresReq
sht.Cells(10, IntCol).Value = AgBrCnt
sht.Cells(11, IntCol).Value = AgAbsFinal
sht.Cells(12, IntCol).Value = AgPosErFinal
sht.Cells(13, IntCol).Value = AgNegErFinal
sht.Cells(14, IntCol).Value = AgStDevFinal
 

'reset all variables
AgPresReq = 0
AgBrCnt = 0
AbsCuVal = 0
AgAbsTotal = 0
AgAbsFinal = 0
AgPosErCnt = 0
AgPosErTotal = 0
AgPosErFinal = 0
AgNegErCnt = 0
AgNegErTotal = 0
AgNegErFinal = 0
AgStDevMean = 0
AgStDevCuVal = 0
AgStDevTotal = 0
AgStDevFinal = 0
AsArCnt = 0
AsBrCnt = 0
AbsAsEr = 0
AbsPosErVal = 0
AbsPosErCnt = 0
AbsNegErCnt = 0
AbsNegErVal = 0
StDevMean = 0
StDevCuVal = 0
StDevTotal = 0
AbsAsErFinal = 0
AbsNegErFinal = 0
StDevFinal = 0
AsArCnt = 0
AgArCnt = 0
Erase AsPresAr
Erase AgPresAr
 
 
 

End Sub

Thanks for the help

 

[WinteE]

Did you already try

If Not Exist

 

[Peter_SSs]

See if this is any use:
http://www.cpearson.com/excel/VBAArrays.htm

 

[Jameo]

See if this is any use:
http://www.cpearson.com/excel/VBAArrays.htm

That is very useful indeed - imported the module and used the IsArrayEmpty function.

Thanks very much Peter