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.
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