I have a macro that creates a very long string by looping through a 2D array which can sometimes contain 30,000 lines. It can take a half hour or more. Is there a way to speed this up. It pulls a spreadsheet into an array and then creates another array with that info. This part doesn't have any issues.
It slows down when looping through the second array which creates a single very long string that is used to create a text file.
Agingarray = XLSbk.Sheets("Aging_Report").Range("A4").CurrentRegion
ReDim FirstArray(1 To UBound(Agingarray) * UBound(Agingarray, 2) * 31, 1 To 8)
i = 1
For x = 2 To UBound(Agingarray)
For y = 4 To LastCol
If Agingarray(x, y) > 50 Then
If Trim(Agingarray(x, 2)) = "" Then Exit For
MI = ""
If InStr(1, Agingarray(x, 2), ",") > 0 Then
Namestr = Split(Agingarray(x, 2), ",")
LastName = Trim(Namestr(0))
Fname = Split(Trim(Namestr(1)), " ")
If Trim(Namestr(1)) <> "" Then
NameFirst = Trim(Fname(0))
If UBound(Fname) = 1 Then
MI = Trim(Fname(1))
End If
Else
NameFirst = ""
End If
Else
LastName = Trim(Agingarray(x, 2))
NameFirst = ""
End If
Monthend = Application.WorksheetFunction.EoMonth(Agingarray(1, y), 0)
For j = Agingarray(1, y) To Monthend
FirstArray(i, 1) = LastName
FirstArray(i, 2) = NameFirst
FirstArray(i, 3) = MI
FirstArray(i, 4) = Agingarray(x, LastCol + 6)
FirstArray(i, 5) = Format(Agingarray(x, LastCol + 8), "000000000")
FirstArray(i, 6) = Agingarray(x, LastCol + 9)
FirstArray(i, 7) = Agingarray(x, LastCol + 10)
FirstArray(i, 8) = j
i = i + 1
Next j
End If
Next y
Next x
This is the part of the code that slows down.
For x = LBound(FirstArray) To UBound(FirstArray)
If FirstArray(x, 1) = "" Then Exit For
Body = Body & "HL*" & h & "*1*21*1~" & PrvLine & "HL*" & i & "*" & j & "*22*0~" & _
"TRN*1*" & Format(Now, "hhmmss") & k & "*" & 9100000000# + k & "*00309417~" & _
"NM1*IL*1*" & FirstArray(x, 1) & "*" & FirstArray(x, 2) & "*" & FirstArray(x, 3) & "***"
If Trim(FirstArray(x, 4)) <> "" Then
Body = Body & "MI*" & Trim(FirstArray(x, 4)) & "~"
LineCount = LineCount + 8
Else
Body = Body & "*~REF*SY*" & Trim(Format(FirstArray(x, 5), "000000000")) & "~"
LineCount = LineCount + 9
End If
Body = Body & "DMG*D8*" & Trim(Format(FirstArray(x, 6), "yyyymmdd")) & "*" & Trim(FirstArray(x, 7)) & "~" & _
"DTP*291*D8*" & Format(FirstArray(x, 8), "yyyymmdd") & "~" & _
"EQ*30~"
h = h + 2
i = i + 2
j = j + 2
k = k + 1
Next x