Speeding up this macro

jryker

New Member
Joined
Apr 12, 2013
Messages
14
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.

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
 

Some videos you may like

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type

sergioMabres

Well-known Member
Joined
Feb 24, 2013
Messages
946
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
 

James Snyder

Well-known Member
Joined
Jan 11, 2013
Messages
618
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:
Code:
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

Well-known Member
Joined
Feb 24, 2013
Messages
946

ADVERTISEMENT

yes it is much faster, the vba is almost the same but the middle is different is
Code:
    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
 
Last edited:

James Snyder

Well-known Member
Joined
Jan 11, 2013
Messages
618
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]
 
Last edited:

jryker

New Member
Joined
Apr 12, 2013
Messages
14

ADVERTISEMENT

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

Well-known Member
Joined
Jan 11, 2013
Messages
618
No, assign each one separately. It can be one line, but each variable needs to be assigned to a type. ie:
Code:
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

Well-known Member
Joined
Feb 24, 2013
Messages
946
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,518
Messages
5,596,630
Members
414,082
Latest member
sasmita

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
Top