out of memory with small array

SFGiants21256

New Member
Joined
Apr 12, 2012
Messages
25
All,

I've ran into an error with my code where it gives me an out of memory error after i try to paste an array to a range. I've read through a lot of posts and everything seems to be with arrays in very large sizes which mine only has 13,000 rows. The strangest part is i have some string variables which depending on how I empty/clear them will determine if I have an out of memory error. I orginially had the code where it looped through a few hundred rows then I reduced it to a hundred and started receiving the errors, which didn't make sense to me because I reduced the amount of data.

Things i have tried:
- Changing my variable input from .value2 to .value
- Changing the "des[var]" variables to a string and using ="" for blanks (the code would error when I was clearing them each iteration through the loop)
- Changing the "des[var]" variables to a variant and using null for blanks (the code would error when I was clearing them each iteration through the loop)

I'd also get an out of memory error if the Des[Var] string was written a certain way. The [var] is because there are multiple variables with a similar name and all create the same problem.

Error: "Trim(AInfo(ARow, 11) & vbNewLine & Des[Var]
No error:"Des[Var] & vbNewLine & "-" & Trim(AInfo(ARow, 11)

I know this is going to be something very simple and easy but I don't know what it is or why.

Thanks for all the help.

Code:
Sub iterateThroughAll()
    ScreenUpdating = False
    Dim OpenDiscrepancies As Worksheet
    Dim AData As Worksheet
    Set OpenDiscrepancies = ThisWorkbook.Worksheets("Open Discrepancies")
    Set AData = ThisWorkbook.Worksheets("AData")
    Dim Results() As Variant
    Dim AInfo() As Variant
    Dim NumDiscrepancy As Integer
    Dim NumBlank As Integer
    Dim NumInspection As Integer
    Dim NumDiagonal As Integer
    Dim NumA As Integer
    Dim NumJ As Integer
    Dim NumL As Integer
    Dim NumX As Integer
    Dim NumZ As Integer
    Dim NarDiscrepancy As String
    Dim NarBlank As String
    Dim NarInspection As String
    Dim NarDiagonal As String
    Dim NarA As String
    Dim NarJ As String
    Dim NarL As String
    Dim NarX As String
    Dim NarZ As String
    Dim MissionDateTimeLocal As Date
    Dim JobStartDateTimeLocal As Date
    Dim JobCompleteDateTimeLocal As Date
    Dim JobStartDateTimeZulu As Date
    Dim JobCompleteDateTimeZulu As Date
    Dim Narrative As String
    
    'Last Row on Open Discrepancies
    Dim OpenrowRange As Range
    Dim OpencolRange As Range


    Dim OpenLastCol As Long
    Dim OpenLastRow As Long
    OpenLastRow = OpenDiscrepancies.Cells(OpenDiscrepancies.Rows.Count, "A").End(xlUp).Row


    Set OpenrowRange = OpenDiscrepancies.Range("A1:A" & OpenLastRow)
    
    'Last Row for ALIS Data
    Dim ArowRange As Range


    Dim ALastRow As Long
    ALastRow = AData.Cells(AData.Rows.Count, "A").End(xlUp).Row


    Set ArowRange = AData.Range("A1:A" & OpenLastRow)
        
    'Populate Array Based on Data (value2 takes the value and format)
    Results() = OpenDiscrepancies.Range("B1:F" & OpenLastRow).Value2
    AInfo() = AData.Range("A1:K" & ALastRow).Value2
    
    'ReDim Results Array to ensure it has enough columns
    ReDim Preserve Results(1 To UBound(Results, 1), 1 To 23)
    
    'Default counting variables
    NumDiscrepancy = 0
    NumBlank = 0
    NumInspection = 0
    NumDiagonal = 0
    NumRed = 0
    NumA = 0
    NumJ = 0
    NumL = 0
    NumX = 0
    NumZ = 0
   
    'Loop through each row in the open descrepancy
    For OpenRow = 2 To OpenLastRow


        'Determine the mission time for the row examining
        MissionDateTimeLocal = CDate(Results(OpenRow, 1)) + CDate(Results(OpenRow, 2))
        'Loop through each row for AData
        For ARow = 2 To ALastRow
            
            'Determine Job Start Time for the row (data is Zulu)
            JobStartDateTimeZulu = CDate(AInfo(ARow, 3)) + CDate(AInfo(ARow, 4))
            'Convert ZULU to local time
            Select Case JobStartDateTimeZulu
                Case Is >= "11/03/2019 02:00"
                    'DST Ended on 3 Nov
                    JobStartDateTimeLocal = DateAdd("h", -8, JobStartDateTimeZulu)
                Case Is >= "03/10/2019 02:00"
                    ' DST Started
                    JobStartDateTimeLocal = DateAdd("h", -7, JobStartDateTimeZulu)
                Case Is >= "11/04/2018 02:00"
                    ' DST Ended
                    JobStartDateTimeLocal = DateAdd("h", -8, JobStartDateTimeZulu)
                Case Is >= "03/11/2018 02:00"
                    'DST Start
                    JobStartDateTimeLocal = DateAdd("h", -7, JobStartDateTimeZulu)
                Case Is >= "11/05/2017 02:00"
                    ' DST Ended
                    JobStartDateTimeLocal = DateAdd("h", -8, JobStartDateTimeZulu)
                Case Is >= "03/12/2017 02:00"
                    'DST Start
                    JobStartDateTimeLocal = DateAdd("h", -7, JobStartDateTimeZulu)
                Case Is >= "11/06/2016 02:00"
                    ' DST Ended
                    JobStartDateTimeLocal = DateAdd("h", -8, JobStartDateTimeZulu)
                Case Is >= "03/13/2016 02:00"
                    'DST Start
                    JobStartDateTimeLocal = DateAdd("h", -7, JobStartDateTimeZulu)
            End Select
            
            'Determine Job complete time for the row
            'Make sure job is not blank (ALIS data is Zulu)
            If AInfo(ARow, 6) <> "" Then
                JobCompleteDateTimeZulu = CDate(AInfo(ALISRow, 6)) + CDate(AInfo(ARow, 7))
                
            'Convert ZULU to local time
            Select Case JobCompleteDateTimeZulu
                Case Is >= "11/03/2019 02:00"
                    'DST Ended on 3 Nov
                    JobCompleteDateTimeLocal = DateAdd("h", -8, JobCompleteDateTimeZulu)
                Case Is >= "03/10/2019 02:00"
                    ' DST Started
                    JobCompleteDateTimeLocal = DateAdd("h", -7, JobCompleteDateTimeZulu)
                Case Is >= "11/04/2018 02:00"
                    ' DST Ended
                    JobCompleteDateTimeLocal = DateAdd("h", -8, JobCompleteDateTimeZulu)
                Case Is >= "03/11/2018 02:00"
                    'DST Start
                    JobCompleteDateTimeLocal = DateAdd("h", -7, JobCompleteDateTimeZulu)
                Case Is >= "11/05/2017 02:00"
                    ' DST Ended
                    JobCompleteDateTimeLocal = DateAdd("h", -8, JobCompleteDateTimeZulu)
                Case Is >= "03/12/2017 02:00"
                    'DST Start
                    JobCompleteDateTimeLocal = DateAdd("h", -7, JobCompleteDateTimeZulu)
                Case Is >= "11/06/2016 02:00"
                    ' DST Ended
                    JobCompleteDateTimeLocal = DateAdd("h", -8, JobCompleteDateTimeZulu)
                Case Is >= "03/13/2016 02:00"
                    'DST Start
                    JobCompleteDateTimeLocal = DateAdd("h", -7, JobCompleteDateTimeZulu)
            End Select
                
            End If


            
            'Check if Adata is the same equipment as OpenRow
            If AInfo(ARow, 1) = Results(OpenRow, 4) Then
                'Check if mission date/time is after the job started date/time
                If JobStartDateTimeLocal <= MissionDateTimeLocal Then
                    'Check If mission date/time is before the job completion date/time
                    If JobCompleteDateTimeLocal >= MissionDateTimeLocal Or AInfo(ARow, 6) = "" Then


                        'Now we know the descrepancy is open during the mission for the aircraft.
                        
                        'Increase the number of discrepancies found
                        NumDiscrepancy = NumDiscrepancy + 1
                        
                        'Concatenate the descrepancies
                        If DesDiscrepancy = "" Then
                            DesDiscrepancy = "-" & Trim(AInfo(ARow, 11))
                        Else
                            DesDiscrepancy = DesDiscrepancy & vbNewLine & "-" & Trim(AInfo(ARow, 11))
                        End If
                        
                        'Check Severity Code
                        Select Case AInfo(ARow, 10)
                            'Blanks
                            Case Is = 0
                                'Increase the number of discrepancies found
                                NumBlank = NumBlank + 1
                        
                                'Concatenate the descrepancies
                                If DesBlank = "" Then
                                    DesBlank = "-" & Trim(AInfo(ARow, 11))
                                Else
                                    DesBlank = DesBlank & vbNewLine & "-" & Trim(AInfo(ARow, 11))
                                End If
                            'Inspection
                            Case Is = "-"
                                'Increase the number of discrepancies found
                                NumInspection = NumInspection + 1
                        
                                'Concatenate the descrepancies
                                If DesInspection = "" Then
                                    DesInspection = "-" & Trim(AInfo(ARow, 11))
                                Else
                                    DesInspection = DesInspection & vbNewLine & "-" & Trim(AInfo(ARow, 11))
                                End If
                            'Diagonal
                            Case Is = "/"
                                'Increase the number of discrepancies found
                                NumDiagonal = NumDiagonal + 1
                        
                                'Concatenate the descrepancies
                                If DesDiagonal = "" Then
                                    DesDiagonal = "-" & Trim(AInfo(ARow, 11))
                                Else
                                    DesDiagonal = DesDiagonal & vbNewLine & "-" & Trim(AInfo(ARow, 11))
                                End If
                            'Red X
                            Case Is = "X"
                                'Increase the number of discrepancies found
                                NumX = NumX + 1
                        
                                'Concatenate the descrepancies
                                If DesX = "" Then
                                    DesX = "-" & Trim(AInfo(ARow, 11))
                                Else
                                    DesX = DesX & vbNewLine & "-" & Trim(AInfo(ARow, 11))
                                End If
                            'A
                            Case Is = "A"
                                'Increase the number of discrepancies found
                                NumA = NumA + 1
                        
                                'Concatenate the descrepancies
                                If DesA = "" Then
                                    DesA = "-" & Trim(AInfo(ARow, 11))
                                Else
                                    DesA = DesA & vbNewLine & "-" & Trim(AInfo(ARow, 11))
                                End If
                            'J
                            Case Is = "J"
                                'Increase the number of discrepancies found
                                NumJ = NumJ + 1
                        
                                'Concatenate the descrepancies
                                If DesJ = "" Then
                                    DesJ = "-" & Trim(AInfo(ARow, 11))
                                Else
                                    DesJ = DesJ & vbNewLine & "-" & Trim(AInfo(ARow, 11))
                                End If
                            'L
                            Case Is = "L"
                                'Increase the number of discrepancies found
                                NumL = NumL + 1
                        
                                'Concatenate the descrepancies
                                If DesL = "" Then
                                    DesL = "-" & Trim(AInfo(ARow, 11))
                                Else
                                    DesL = DesL & vbNewLine & "-" & Trim(AInfo(ARow, 11))
                                End If
                            'Z
                            Case Is = "Z"
                                'Increase the number of discrepancies found
                                NumZ = NumZ + 1
                        
                                'Concatenate the descrepancies
                                If DesZ = "" Then
                                    DesZ = "-" & Trim(AInfo(ARow, 11))
                                Else
                                    DesZ = DesZ & vbNewLine & "-" & Trim(AInfo(ARow, 11))
                                End If
                        End Select
                    End If
                End If
            End If
            
            'Clear Date/Time Variables
            JobStartDateTimeLocal = Empty
            JobCompletionDateTime = Empty
            
        Next ALISRow
        
        'Update results array with totals after looping through all Adata
        Results(OpenRow, 6) = NumDiscrepancy
        Results(OpenRow, 7) = Trim(DesDiscrepancy)
        Results(OpenRow, 8) = NumBlank
        Results(OpenRow, 9) = Trim(DesBlank)
        Results(OpenRow, 10) = NumInspection
        Results(OpenRow, 11) = Trim(DesInspection)
        Results(OpenRow, 12) = NumDiagonal
        Results(OpenRow, 13) = Trim(DesDiagonal)
        Results(OpenRow, 14) = NumX
        Results(OpenRow, 15) = Trim(DesX)
        Results(OpenRow, 16) = NumA
        Results(OpenRow, 17) = Trim(DesA)
        Results(OpenRow, 18) = NumJ
        Results(OpenRow, 19) = Trim(DesJ)
        Results(OpenRow, 20) = NumL
        Results(OpenRow, 21) = Trim(DesL)
        Results(OpenRow, 22) = NumZ
        Results(OpenRow, 23) = Trim(DesZ)
        
        'Reset Variables
        NumDiscrepancy = 0
        NumBlank = 0
        NumInspection = 0
        NumDiagonal = 0
        NumRed = 0
        NumA = 0
        NumJ = 0
        NumL = 0
        NumX = 0
        NumZ = 0
        DesDiscrepancy = ""
        DesBlank = ""
        DesInspection = ""
        DesDiagonal = ""
        DesX = ""
        DesA = ""
        DesJ = ""
        DesL = ""
        DesZ = ""
        


        MissionDateTimeLocal = Empty


    Next OpenRow


    OpenDiscrepancies.Range("E1:E" & OpenLastRow).NumberFormat = "@"
    OpenDiscrepancies.Range("B1:X" & OpenLastRow) = Results()
        
    ScreenUpdating = True
    
    MsgBox ("Complete")
    
    'Clear Arrays
    Erase Results
    Erase AInfo


    
End Sub
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
I don't know how much mileage you will get but you are not turning off ScreenUpdating as written. Should be Application.ScreenUpdating = False. Also if you add Option Explicit to the top of the code you have a few undeclared variables, although I don't think that will have any impact. Also perhaps turning off Calculations...
 
Upvote 0
You may try change DIM from INTEGER to LONG.
 
Upvote 0
Where in the code are you getting the error?
 
Last edited:
Upvote 0
First things to look at are the PC

Processor
Memory
Usage before code running
Usage when running (processor and memory)
PC free space
etc .....

Any other applications running IE, Citrix, VPN etc.

Does the same error happen if you restart the PC and run the code without anything open/running

Regards
jiuk
 
Upvote 0
All,

Thanks a ton.

Here are the answers to your questions.

Option Explict - i do have that on, i just didn't copy that part. Sorry dumb move on my part. I did start experiencing more errors when I turned this on.

What do you mean for turning off calculations?

I'll try the integer to long and reply again.

The error comes on the "OpenDiscrepancies.Range("B1:X" & OpenLastRow) = Results()" line.

I've tried restarting excel, restarting the computer, and only running the code (and task manager). When I run task manager the memory on the computer doesn't fill up either. It does increase about 10-20% when I open the excel file however, it doesn't change much when I run the program.
 
Upvote 0
Here is a full update of the code. Same result so far.

Code:
Option Explicit


Sub iterateThroughAll()
    Application.ScreenUpdating = False
    Dim OpenDiscrepancies As Worksheet
    Dim ALISData As Worksheet
    Set OpenDiscrepancies = ThisWorkbook.Worksheets("Open Discrepancies")
    Set ALISData = ThisWorkbook.Worksheets("ALIS Data")
    Dim Results() As Variant
    Dim ALISInfo() As Variant
    Dim NumDiscrepancy As Long
    Dim NumBlank As Long
    Dim NumInspection As Long
    Dim NumDiagonal As Long
    Dim NumA As Long
    Dim NumJ As Long
    Dim NumL As Long
    Dim NumX As Long
    Dim NumZ As Long
    Dim DesDiscrepancy As String
    Dim DesBlank As String
    Dim DesInspection As String
    Dim DesDiagonal As String
    Dim DesA As String
    Dim DesJ As String
    Dim DesL As String
    Dim DesX As String
    Dim DesZ As String
    Dim MissionDateTimeLocal As Date
    Dim JobStartDateTimeLocal As Date
    Dim JobCompleteDateTimeLocal As Date
    Dim JobStartDateTimeZulu As Date
    Dim JobCompleteDateTimeZulu As Date
    Dim Narrative As String
    
    'Last Row on Open Discrepancies
    Dim OpenrowRange As Range
    Dim OpencolRange As Range


    Dim OpenRow, ALISRow As Integer
    Dim OpenLastCol As Long
    Dim OpenLastRow As Long
    OpenLastRow = OpenDiscrepancies.Cells(OpenDiscrepancies.Rows.Count, "A").End(xlUp).Row


    Set OpenrowRange = OpenDiscrepancies.Range("A1:A" & OpenLastRow)
    
    'Last Row for ALIS Data
    Dim ALISrowRange As Range
    Dim ALIScolRange As Range


    Dim ALISLastCol As Long
    Dim ALISLastRow As Long
    ALISLastRow = ALISData.Cells(ALISData.Rows.Count, "A").End(xlUp).Row


    Set ALISrowRange = ALISData.Range("A1:A" & OpenLastRow)
        
    'Populate Array Based on Data (value2 takes the value and format)
    Results() = OpenDiscrepancies.Range("B1:F" & OpenLastRow).Value2
    ALISInfo() = ALISData.Range("A1:K" & ALISLastRow).Value2
    
    'ReDim Results Array to ensure it has enough columns
    ReDim Preserve Results(1 To UBound(Results, 1), 1 To 23)
    
    'Default counting variables
    NumDiscrepancy = 0
    NumBlank = 0
    NumInspection = 0
    NumDiagonal = 0
    NumA = 0
    NumJ = 0
    NumL = 0
    NumX = 0
    NumZ = 0


'    Debug.Print GetMemUsage
    
    'Loop through each row in the open descrepancy
    For OpenRow = 2 To OpenLastRow


        'Determine the mission time for the row examining
        MissionDateTimeLocal = CDate(Results(OpenRow, 1)) + CDate(Results(OpenRow, 2))
        'Loop through each row for ALIS Data
        For ALISRow = 2 To ALISLastRow
'            Debug.Print "OpenRow " & OpenRow & " ALISRow " & ALISRow
'            If ALISRow = 13127 Then
'            Debug.Print "Stop"
'            End If
            
            'Determine Job Start Time for the row (ALIS data is Zulu)
            JobStartDateTimeZulu = CDate(ALISInfo(ALISRow, 3)) + CDate(ALISInfo(ALISRow, 4))
            'Convert ZULU to local time
            Select Case JobStartDateTimeZulu
                Case Is >= "11/03/2019 02:00"
                    'DST Ended on 3 Nov
                    JobStartDateTimeLocal = DateAdd("h", -8, JobStartDateTimeZulu)
                Case Is >= "03/10/2019 02:00"
                    ' DST Started
                    JobStartDateTimeLocal = DateAdd("h", -7, JobStartDateTimeZulu)
                Case Is >= "11/04/2018 02:00"
                    ' DST Ended
                    JobStartDateTimeLocal = DateAdd("h", -8, JobStartDateTimeZulu)
                Case Is >= "03/11/2018 02:00"
                    'DST Start
                    JobStartDateTimeLocal = DateAdd("h", -7, JobStartDateTimeZulu)
                Case Is >= "11/05/2017 02:00"
                    ' DST Ended
                    JobStartDateTimeLocal = DateAdd("h", -8, JobStartDateTimeZulu)
                Case Is >= "03/12/2017 02:00"
                    'DST Start
                    JobStartDateTimeLocal = DateAdd("h", -7, JobStartDateTimeZulu)
                Case Is >= "11/06/2016 02:00"
                    ' DST Ended
                    JobStartDateTimeLocal = DateAdd("h", -8, JobStartDateTimeZulu)
                Case Is >= "03/13/2016 02:00"
                    'DST Start
                    JobStartDateTimeLocal = DateAdd("h", -7, JobStartDateTimeZulu)
            End Select
            
            'Determine Job complete time for the row
            'Make sure job is not blank (ALIS data is Zulu)
            If ALISInfo(ALISRow, 6) <> "" Then
                JobCompleteDateTimeZulu = CDate(ALISInfo(ALISRow, 6)) + CDate(ALISInfo(ALISRow, 7))
                
            'Convert ZULU to local time
            Select Case JobCompleteDateTimeZulu
                Case Is >= "11/03/2019 02:00"
                    'DST Ended on 3 Nov
                    JobCompleteDateTimeLocal = DateAdd("h", -8, JobCompleteDateTimeZulu)
                Case Is >= "03/10/2019 02:00"
                    ' DST Started
                    JobCompleteDateTimeLocal = DateAdd("h", -7, JobCompleteDateTimeZulu)
                Case Is >= "11/04/2018 02:00"
                    ' DST Ended
                    JobCompleteDateTimeLocal = DateAdd("h", -8, JobCompleteDateTimeZulu)
                Case Is >= "03/11/2018 02:00"
                    'DST Start
                    JobCompleteDateTimeLocal = DateAdd("h", -7, JobCompleteDateTimeZulu)
                Case Is >= "11/05/2017 02:00"
                    ' DST Ended
                    JobCompleteDateTimeLocal = DateAdd("h", -8, JobCompleteDateTimeZulu)
                Case Is >= "03/12/2017 02:00"
                    'DST Start
                    JobCompleteDateTimeLocal = DateAdd("h", -7, JobCompleteDateTimeZulu)
                Case Is >= "11/06/2016 02:00"
                    ' DST Ended
                    JobCompleteDateTimeLocal = DateAdd("h", -8, JobCompleteDateTimeZulu)
                Case Is >= "03/13/2016 02:00"
                    'DST Start
                    JobCompleteDateTimeLocal = DateAdd("h", -7, JobCompleteDateTimeZulu)
            End Select
                
            End If
            
            'Check if ALIS data is the same aircraft
            If ALISInfo(ALISRow, 1) = Results(OpenRow, 4) Then
                'Check if mission date/time is after the job started date/time
                If JobStartDateTimeLocal <= MissionDateTimeLocal Then
                    'Check If mission date/time is before the job completion date/time
                    If JobCompleteDateTimeLocal >= MissionDateTimeLocal Or ALISInfo(ALISRow, 6) = "" Then


                        'Now we know the descrepancy is open during the mission for the aircraft.
                        
                        'Increase the number of discrepancies found
                        NumDiscrepancy = NumDiscrepancy + 1
                        
                        'Concatenate the descrepancies
                        If DesDiscrepancy = "" Then
'                        If IsNull(DesDiscrepancy) Then
                            DesDiscrepancy = "-" & Trim(ALISInfo(ALISRow, 11))
                        Else
                            DesDiscrepancy = DesDiscrepancy & vbNewLine & "-" & Trim(ALISInfo(ALISRow, 11))
                        End If
                        
                        'Check Severity Code
                        Select Case ALISInfo(ALISRow, 10)
                            'Blanks
                            Case Is = 0
                                'Increase the number of discrepancies found
                                NumBlank = NumBlank + 1
                        
                                'Concatenate the descrepancies
                                If DesBlank = "" Then
'                                If IsNull(DesBlank) Then
                                    DesBlank = "-" & Trim(ALISInfo(ALISRow, 11))
                                Else
                                    DesBlank = DesBlank & vbNewLine & "-" & Trim(ALISInfo(ALISRow, 11))
                                End If
                            'Inspection
                            Case Is = "-"
                                'Increase the number of discrepancies found
                                NumInspection = NumInspection + 1
                        
                                'Concatenate the descrepancies
                                If DesInspection = "" Then
'                                If IsNull(DesInspection) Then
                                    DesInspection = "-" & Trim(ALISInfo(ALISRow, 11))
                                Else
                                    DesInspection = DesInspection & vbNewLine & "-" & Trim(ALISInfo(ALISRow, 11))
                                End If
                            'Diagonal
                            Case Is = "/"
                                'Increase the number of discrepancies found
                                NumDiagonal = NumDiagonal + 1
                        
                                'Concatenate the descrepancies
                                If DesDiagonal = "" Then
'                                If IsNull(DesDiagonal) Then
                                    DesDiagonal = "-" & Trim(ALISInfo(ALISRow, 11))
                                Else
                                    DesDiagonal = DesDiagonal & vbNewLine & "-" & Trim(ALISInfo(ALISRow, 11))
                                End If
                            'Red X
                            Case Is = "X"
                                'Increase the number of discrepancies found
                                NumX = NumX + 1
                        
                                'Concatenate the descrepancies
                                If DesX = "" Then
'                                If IsNull(DesX) Then
                                
                                    DesX = "-" & Trim(ALISInfo(ALISRow, 11))
                                Else
                                    DesX = DesX & vbNewLine & "-" & Trim(ALISInfo(ALISRow, 11))
                                End If
                            'A
                            Case Is = "A"
                                'Increase the number of discrepancies found
                                NumA = NumA + 1
                        
                                'Concatenate the descrepancies
                                If DesA = "" Then
'                                If IsNull(DesA) Then
                                    DesA = "-" & Trim(ALISInfo(ALISRow, 11))
                                Else
                                    DesA = DesA & vbNewLine & "-" & Trim(ALISInfo(ALISRow, 11))
                                End If
                            'J
                            Case Is = "J"
                                'Increase the number of discrepancies found
                                NumJ = NumJ + 1
                        
                                'Concatenate the descrepancies
                                If DesJ = "" Then
'                                If IsNull(DesJ) Then
                                    DesJ = "-" & Trim(ALISInfo(ALISRow, 11))
                                Else
                                    DesJ = DesJ & vbNewLine & "-" & Trim(ALISInfo(ALISRow, 11))
                                End If
                            'L
                            Case Is = "L"
                                'Increase the number of discrepancies found
                                NumL = NumL + 1
                        
                                'Concatenate the descrepancies
                                If DesL = "" Then
'                                If IsNull(DesL) Then
                                    DesL = "-" & Trim(ALISInfo(ALISRow, 11))
                                Else
                                    DesL = DesL & vbNewLine & "-" & Trim(ALISInfo(ALISRow, 11))
                                End If
                            'Z
                            Case Is = "Z"
                                'Increase the number of discrepancies found
                                NumZ = NumZ + 1
                        
                                'Concatenate the descrepancies
                                If DesZ = "" Then
'                                If IsNull(DesZ) Then
                                    DesZ = "-" & Trim(ALISInfo(ALISRow, 11))
                                Else
                                    DesZ = DesZ & vbNewLine & "-" & Trim(ALISInfo(ALISRow, 11))
                                End If
                        End Select
                    End If
                End If
            End If
            
            'Clear Date/Time Variables
            JobStartDateTimeLocal = Empty
            JobCompleteDateTimeLocal = Empty
            
            
        Next ALISRow
        
        'Update results array with totals after looping through all ALIS data
        Results(OpenRow, 6) = NumDiscrepancy
        Results(OpenRow, 7) = Trim(DesDiscrepancy)
        Results(OpenRow, 8) = NumBlank
        Results(OpenRow, 9) = Trim(DesBlank)
        Results(OpenRow, 10) = NumInspection
        Results(OpenRow, 11) = Trim(DesInspection)
        Results(OpenRow, 12) = NumDiagonal
        Results(OpenRow, 13) = Trim(DesDiagonal)
        Results(OpenRow, 14) = NumX
        Results(OpenRow, 15) = Trim(DesX)
        Results(OpenRow, 16) = NumA
        Results(OpenRow, 17) = Trim(DesA)
        Results(OpenRow, 18) = NumJ
        Results(OpenRow, 19) = Trim(DesJ)
        Results(OpenRow, 20) = NumL
        Results(OpenRow, 21) = Trim(DesL)
        Results(OpenRow, 22) = NumZ
        Results(OpenRow, 23) = Trim(DesZ)
        
        'Reset Variables
        NumDiscrepancy = 0
        NumBlank = 0
        NumInspection = 0
        NumDiagonal = 0
        NumA = 0
        NumJ = 0
        NumL = 0
        NumX = 0
        NumZ = 0
        
        DesDiscrepancy = Empty
        DesBlank = Empty
        DesInspection = Empty
        DesDiagonal = Empty
        DesX = Empty
        DesA = Empty
        DesJ = Empty
        DesL = Empty
        DesZ = Empty
        
'        DesDiscrepancy = Null
'        DesBlank = Null
'        DesInspection = Null
'        DesDiagonal = Null
'        DesX = Null
'        DesA = Null
'        DesJ = Null
'        DesL = Null
'        DesZ = Null
        


        MissionDateTimeLocal = Empty
'        Debug.Print GetMemUsage
'        Debug.Print Application.MemoryFree & "/" & Application.MemoryTotal
    Next OpenRow
    
    Results(1, 6) = "Total Discrepancies"
    Results(1, 7) = "Narrative"
    Results(1, 8) = "Total Blank"
    Results(1, 9) = "Blank Narrative"
    Results(1, 10) = "Total Inspection"
    Results(1, 11) = "Inspection Narrative"
    Results(1, 12) = "Total Diagonals"
    Results(1, 13) = "Diagonal Narrative"
    Results(1, 14) = "Total Red X"
    Results(1, 15) = "Red X Narrative"
    Results(1, 16) = "Total A"
    Results(1, 17) = "A Narrative"
    Results(1, 18) = "Total J"
    Results(1, 19) = "J Narrative"
    Results(1, 20) = "Total L"
    Results(1, 21) = "L Narrative"
    Results(1, 22) = "Total Z"
    Results(1, 23) = "Z Narrative"
        
    OpenDiscrepancies.Range("E1:E" & OpenLastRow).NumberFormat = "@"
    OpenDiscrepancies.Range("B1:X" & OpenLastRow) = Results()
        
    Application.ScreenUpdating = True
    
    MsgBox ("Complete")
    
    'Clear Arrays
    Erase Results
    Erase ALISInfo


    
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,622
Messages
6,120,580
Members
448,972
Latest member
Shantanu2024

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top