I’m looking for feedback on A) How to possibly speed up this code and B) Maybe a suggestion of a different way of doing it.
To goal is analyzation of some rainfall data. The macro (which is not mine) opens up a text file, copies the data, pastes it and then filters it out based on a gridcode. The process sometimes can take hours to run based on the amount of text files it needs to run through.
My gut tells me this open, copy method is not the most effective way to go about this. I would like to hear some feedback both on improving the existing code below and maybe how you might go about accomplishing this task.
To goal is analyzation of some rainfall data. The macro (which is not mine) opens up a text file, copies the data, pastes it and then filters it out based on a gridcode. The process sometimes can take hours to run based on the amount of text files it needs to run through.
My gut tells me this open, copy method is not the most effective way to go about this. I would like to hear some feedback both on improving the existing code below and maybe how you might go about accomplishing this task.
Code:
Sub OpenTEXT()
Dim start_time, end_time
start_time = Now()
Dim Iyear, Imonth, Iday, dayMax As Integer
Dim filenameIN, filenameOUT, Syear, Smonth, Sday As String
Dim rowcounter As Double
Dim outputROW As Double
Dim arrayfiller, DataArray(1 To 100000, 1 To 6) As Double
Dim i, j As Double
Application.ScreenUpdating = False
outputROW = 1
For Iyear = 1948 To 1949
For Imonth = 1 To 12
If Imonth = 1 Or Imonth = 3 Or Imonth = 5 Or Imonth = 7 Or Imonth = 8 Or Imonth = 10 Or Imonth = 12 Then
dayMax = 31
ElseIf Imonth = 4 Or Imonth = 6 Or Imonth = 9 Or Imonth = 11 Then
dayMax = 30
ElseIf Iyear Mod 4 = 0 Then
dayMax = 29
Else: dayMax = 28
End If
For Iday = 1 To 2
If Iday = 26 And Imonth = 2 And Iyear = 2007 Then
Iday = Iday + 1
End If
If Imonth < 10 Then
Smonth = "0" & Imonth
Else: Smonth = Imonth
End If
If Iday < 10 Then
Sday = "0" & Iday
Else: Sday = Iday
End If
rowcounter = 2
filenameIN = "H:\ExcelTesting\1940s\p" & Iyear & Smonth & Sday & "_sj.txt"
Workbooks.OpenTEXT Filename:= _
filenameIN, Origin:=437, StartRow:=1 _
, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, Comma:=False _
, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array _
(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), TrailingMinusNumbers:=True
For rowcounter = 2 To 100000
If Cells(rowcounter, 6).Value = 11223 Or Cells(rowcounter, 6).Value = 11224 Or Cells(rowcounter, 6).Value = 12423 Or Cells(rowcounter, 6).Value = 11225 Or Cells(rowcounter, 6).Value = 13332 Then
For arrayfiller = 1 To 6
DataArray(outputROW, arrayfiller) = Cells(rowcounter, arrayfiller).Value
Next arrayfiller
' MsgBox ("data array vals will be ") & DataArray(outputROW, 1) & " / " & DataArray(outputROW, 2) & " / " & DataArray(outputROW, 3) & " / " & DataArray(outputROW, 4) & " / " & DataArray(outputROW, 5) & " / " & DataArray(outputROW, 6)
outputROW = outputROW + 1
End If
Next rowcounter
' filenameOUT = "H:\ExcelTesting\1940s\Excel\p" & Iyear & Smonth & Sday & "_sj.xlsm"
'
' ActiveWorkbook.SaveAs filename:=filenameOUT, _
' FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
Next Iday
Next Imonth
Next Iyear
Windows("1948-01-03-test.xlsm").Activate
For i = 1 To 100000
For j = 1 To 6
Cells(i, j).Value = DataArray(i, j)
Next j
Next i
Application.ScreenUpdating = True
end_time = Now()
MsgBox (DateDiff("s", start_time, end_time)) & " seconds"
End Sub