Speeding up this macro

[jryker]

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.

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

 

[sergioMabres]

May be, i need the txt file to test we could speed up by
Workbooks.OpenTEXT ' that is the same that your macro does
filter using excel filtering where col(6) is 11223 Or 11224 Or 12423 Or 11225 Or 13332 ' very different from what the macro does (has an if and copies from txt to array)
finaly save as xls ' very different from what the macro does (copies from array to new sheet)

I guess that is faster
Sergio

 

[jryker]

One of the text files:

https://docs.google.com/file/d/0B_TG3GfAlpG4RlVaQ3E1YTdpajQ/edit?usp=sharing

 

[James Snyder]

I can see several things that will speed your code.
• You have Iyear, Imonth and Iday defined as type variant...it takes longer to process Variant as it has to figure out how to handle the value each time. Try this:

Dim Iyear As Integer
Dim Imonth As Integer
Dim Iday as Integer

• You have nested for loops for filling the cells. This takes a lot of time as each cell needs to be evaluated many times. Investigate using .Autofilter or .Advancedfilter to do it in batches.

 

[sergioMabres]

yes it is much faster, the vba is almost the same but the middle is different is

    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
    Range("F1").Formula = "GRIDCODE"
    Columns("E:E").Delete Shift:=xlToLeft
    Selection.CurrentRegion.Select
    Selection.AutoFilter Field:=5, Criteria1:=Array( _
        "11.223.000.000", "11.224.000.000", "12.423.000.000", "11.225.000.000", "13.332.000.000"), Operator:=xlFilterValues
    Selection.CurrentRegion.Select
    Selection.Copy
    Windows("Libro1.xlsm").Activate
    ActiveSheet.Paste

This is not the new macro is the part that will replace the array
change "Libro1.xlsm" in Windows("Libro1.xlsm").Activate for your file name and test
After integrating both codes you will have to test and adjust minor errors in real environment, tha is to say real directories and drives
I hope this helps
Sergio

 

[James Snyder]

Forgot one very useful addition:
• Use a querytable for the text file. I used to have long running macros when importing large .csv or .txt files, and using a querytable dropped processing time from ~ 20 minutes to ~20 seconds. One specific example was taking around 2-3 hours and using a querytable dropped it to less than a minute, but that was an optimal situation. A link:
QueryTables Collection Object [Excel 2003 VBA Language Reference]

 

[jryker]

James -
So you saying to Dim out each individually instead of one line?

Sergio -
Tried and it was quick but the data is all hidden somehow. Can you show me how to integrate it by replacing it in line with my code?

 

[James Snyder]

No, assign each one separately. It can be one line, but each variable needs to be assigned to a type. ie:

Dim Iyear As Integer, Imonth As Integer, Iday As Integer

The default for not adding a specific type is to use variant to handle anything.

 

[sergioMabres]

the idea is to hide rows, copy, and paste (hidden rows are not copied) on the sheet that has the macro, let us call it "1948-01-03-test.xlsm", then open the next file do the same, copy and paste at the end of "1948-01-03-test.xlsm" when the macro is finished you will have all rows in "1948-01-03-test.xlsm"

I agree with james about auto filter, that is much faster than the for next, and I also think that instead of using the giant array use copy and paste
I think the giant array is taking all the time, the macro is doing it twice! (for i = 1 to 100000) just because it does not know how big is the text file
you can do a Selection.CurrentRegion.Select as I showed in the macro that is much faster

I can try to integrate the changes but then I will be doing the whole macro, I thought you where looking for a feedback on How to possibly speed up this code and Maybe a suggestion of a different way of doing it.

Sergio