vba newbie. Need help in efficient macro.

[nkagar2]

Hello All!


I have had so much help with online forums and thank everyone for their help and advice. I was wondering if someone could help me with my macro. I am a civil engineer with no programming knowledge. Most of the vba macro I created is by using codes from this forum or by recording in excel and extending it a little further. It has worked so far however it takes hours and hours to process all the files. I now have a folder with over 600 files that I have to process and I have let it run overnight and it has successfully however I cannot present it to the users since it is time consuming. Couple of specific issues that I as a non-programmer can mention is:


1. Module 37 is the master list of all the macro I use --- I dont think this has any issues
2. Call one is pretty straight forward - it imports all the csv like files into the current workbook -- Don't think this has any issues
3. Call two (module 6) - calculates average speed and uniformity metrics. --- This is the one I think has major issues. Since the data is variable, I did not know how to mention "check for rows with values and calculate average". Instead, I calculate average of full columns or sometimes specific cell numbers which in this case I set it as 3600 rows. Then all the calculations are done cell by cell since I recorded macro and generalized. This macro takes a ton of time.


4. Module 29 also is recorded and is time consuming.


5. Module 33 is also recorded and takes time to copy and paste formula cell by cell.




I was wondering if anyone out here could help/ guide? I have attached the macro for your reference (https://www.dropbox.com/s/r1ayuea9v033n3j/backup_0929_1230.xlsm?dl=00). Thanks in advance!


Sarah

 

[bertie]

Hi, and welcome to the forum.

This forum has a word limit for responses so my comments may take one or two posts, bear with me.

We can rename code modules. For example
Select Module3
View => Properties Window
And name it, say, "ImportCsvFiles"

Import CSV Files
===========
In your code you have an array for file names.
You loop through the array to populate the filenames, ReDim Preserving as you go.
You loop through the array a second time to process the file.

   Application.ScreenUpdating = False
   Set Basebook = ThisWorkbook
   
   'Fill the array(myFiles)with the list of Excel files in the folder
   Fnum = 0
   Do While FilesInPath <> ""
      Fnum = Fnum + 1
      ReDim Preserve MyFiles(1 To Fnum)
      MyFiles(Fnum) = FilesInPath
      FilesInPath = Dir()
   Loop
   
   'Loop through all files in the array(myFiles)
   If Fnum > 0 Then
      For Fnum = LBound(MyFiles) To UBound(MyFiles)
         Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
         mybook.Worksheets(1).copy After:= _
         Basebook.Sheets(Basebook.Sheets.count)
   
         On Error Resume Next
            ActiveSheet.Name = mybook.Name
         On Error GoTo 0


      ' You can use this if you want to copy only the values
      ' With ActiveSheet.UsedRange
      ' .Value = .Value
      ' End With


         mybook.Close savechanges:=False
      Next Fnum
   End If

ReDim Preserving arrays takes a lot of processing, as do loops. We don't need the array. This is a useful approach when you need the array of filenames for other procedures, but I can't see you reusing this.

We can loop directly through the files in the folder. The Do...Loop ends when there are no files left to process.

   '=====================
   'process the csv files
   '=====================
   Set wbMain = ThisWorkbook
      
   On Error GoTo errImportCsv 'reset application settings in event of error
   DisableApplicationSettings
   
   strFile = Dir(strPath & "*.CSV")
   Do Until strFile = ""
      Set wbSource = Workbooks.Open(strPath & strFile)
      wbSource.Worksheets(1).copy _
         After:=wbMain.Sheets(wbMain.Sheets.count)
      ActiveSheet.Name = wbSource.Name
      
      'get the next file
      wbSource.Close SaveChanges:=False
      strFile = Dir()
   Loop

To test this change:
Make a copy of your workbook
Place a couple of csv files in a folder, if the code works for 2 files, it will work for 100.
Rather than just running the code, Press F8 to step through it.
You can use the, Alt+Tab, short-cut combination to flick between Excel and the VBA editor window.


End post 1/3

 

[bertie]

Post 2/3

Select Module6
Click View => Properties Window
Rename it, say, "AverageSpeed"

Average Speed Procedure
================
You are correct that processing entire columns will impact on the performance of your code. So we will need a function to determine the number of rows in a specific column we need to process. We will be using this repeatedly for different sheets, and columns so we pass these variables to the function as arguments.

Function GetRowCount(ByVal sheetName As String, _
                     ByVal ColumnLetter As String) As Long
                     
   GetRowCount = Sheets(sheetName).Range(ColumnLetter, Rows.count).End(xlUp).Row
End Function

In your code you set up a range,
Calculate the average.
Insert a formula.
Autofill the formula.

   Set range1 = Range("D:D")
   
   Range("N1") = WorksheetFunction.Average(range1)
   Range("O1").Value = "=IF(RC[-11]="""","""",ABS(RC[-11]-R1C14))"
       Range("O1").Select
       Selection.AutoFill Destination:=Range("O1:O3600")
       Range("O1:O3600").Select

It would be simpler if your just placed an average formula in N1
And, rather than autofill, just place your formula into the range, O1:O3600

         'n1 = average column D
         rowCount = GetRowCount(sheetName, "D")
         ws.Range("N1").Formula = "=Average(D1:D" & rowCount & ")"
         
         '=IF(D1="","",ABS(D1-$N$1))
          ws.Range("O1:O" & rowCount).Formula = "=IF(D1="""","""",ABS(D1-$N$1))"

Excel is clever enough to increment the row numbers in the formula over the range.
This negates the need to set up ranges, which will improve performance.

Note how I called the function to get the number of rows to process.
Note also that I have changed the formula from R1C1 notation. Inserting variable into R1C1 notation is horrendous.
This is not necessary but I think you will agree it makes the code easier to read.

I have updated this procedure using the above.
To test make a copy of your workbook.
Import one csv file. If it works for one...
Press F8 to step through the code.
Use Alt+Tab to "flick" between sheets.
Correct any errors I have made in the formula.

Sub Two_Avg_Speed_Loop()
   Dim ws As Worksheet
   Dim wbMain As Workbook
   Dim rowCount As Long
   Dim sheetName As String
   
   On Error GoTo errAvgSpeed  're-enable application settings in event of error
   DisableApplicationSettings
   
   Set wbMain = ThisWorkbook
   
   For Each ws In wbMain.Worksheets
      If UCase(ws.Name) Like "*.CSV" Then
         
         'Stop
         sheetName = ws.Name
         
         'n1 = average column D
         rowCount = GetRowCount(sheetName, "D")
         ws.Range("N1").Formula = "=Average(D1:D" & rowCount & ")"
         
         '=IF(D1="","",ABS(D1-$N$1))
          ws.Range("O1:O" & rowCount).Formula = "=IF(D1="""","""",ABS(D1-$N$1))"
          
         'P1 = average column O
         rowCount = GetRowCount(sheetName, "O")
         ws.Range("P1").Formula = "=Average(O1:O" & rowCount & ")"
         
         '=IF(O1="","",ABS(O1-$N$1))
         ws.Range("Q1:Q3600").Formula = "=IF(O1="""","""",ABS(O1-$N$1))"
                  
         'R1 = average column Q
         rowCount = GetRowCount(sheetName, "Q")
         ws.Range("R1").Formula = "=Average(Q1:Q" & rowCount & ")"
         
         '=IF(O1="","",ABS(1-O1))
         ws.Range("S1:S3600").Formula = "=IF(O1="""","""",ABS(1-O1))"
         
         'T1 = average column S
         rowCount = GetRowCount(sheetName, "S")
         ws.Range("T1").Formula = "=Average(S1:S" & rowCount & ")"
         
         'Stop


         '============================
         'percent green calculations
         '===========================
         ws.Range("U1").Value = 1
         
         '=IF(M2="",U1,1+U1)
         ws.Range("U2:U3600").Formula = "=IF(M2="""",U1,1+U1)"
         ws.Range("V1:V3600").Formula = "=D1"
         ws.Range("W1").Value = 1
         ws.Range("W2:W20").Formula = "=W1+1"
    
         ws.Range("X1:X3600").FormulaArray = _
             "=MIN(IF((R1C21:R3600C21=RC[-1])*(R1C22:R3600C22<100),R1C22:R3600C22))"
         
         rowCount = GetRowCount(sheetName, "M")
         ws.Range("Y1").Formula = "=COUNTA(M1:M" & rowCount & ")"
         ws.Range("Z1").Formula = "=Y1+1"
         ws.Range("AA1:AA3600").Formula = "=IF(W1>$Z$1,"""",W1)"
         ws.Range("AB1:AB3600").Formula = "=IF(AA1="""","""",X1)"
         
         rowCount = GetRowCount(sheetName, "AB")
         ws.Range("AC1").Formula = "=COUNTIF(AB1:AB" & rowCount & ",0)"
         
         ws.Range("AD1").Formula = "=Y1-AC1"
         ws.Range("AE1").Formula = "=AD1/Y1"
         ws.Range("AE1").NumberFormat = "0.00"
         
         rowCount = GetRowCount(sheetName, "J")
         ws.Range("AF1") = WorksheetFunction.max(ws.Range("J1:J" & rowCount))


      End If
      
   Next ws


errAvgSpeed:
   EnableApplicationSettings


End Sub

Throughout your code you disable, then re-enable application settings. I have set up two function to do this:

Function DisableApplicationSettings()
   With Application
      .DisplayAlerts = False
      .ScreenUpdating = False
   End With
End Function


Function EnableApplicationSettings()
   With Application
      .DisplayAlerts = True
      .ScreenUpdating = True
   End With
End Function

Note I have used an error trap to ensure application setting are reset in the event of the code crashing.
When testing, and stepping though the code, you may end the code before it gets to this.
You may find a "reset" procedure useful.

Sub Reset()
   EnableApplicationSettings
End Sub

End post 2/3

 

[bertie]

Post 3/3

This will cover points 4 and 5 in you initial post.
It will involve you stepping through the code (F8), reading what each line is doing, and making the edits.

Recording macros is extremely useful, but it does produce bloated code.
Let's tidy it up:

Delete any lines of code which involve scrolling.

    ActiveWindow.ScrollRow = 168
    ActiveWindow.ScrollRow = 162
'etc

You will find code which is made redundant, ie., you try something, oops that's wrong, try again. All this is recorded by the macro. If you find you are doing different things to the same range, it is usually the last thing you do which is correct. This is where stepping through the code, F8, helps.

For example, after removing the, "scrolls", what does this code actually supposed to do?

Range("N1:N201").Select
    Selection.Cut
    Range("N2").Select
    ActiveSheet.Paste
    Range("N2").Select
    Range("N2:N201").Select
    Selection.copy
    Application.CutCopyMode = False

You don't need to select a range in order to use it. Just go ahead and do with it what you will. So you can delete the stuff highlighed red.
This gives:

   Range("N1:N201").Cut
   Range("N2").Paste
   Range("N2:N201").copy
   Application.CutCopyMode = False

Now all this looks like it's doing is moving N1 down one row.
If that is the case you can use:

   Range("N1").Insert Shift:=xlDown

Or, if this code is not doing anything you need you can delete it. If you are not sure, you can comment it out and test to see the results.
In the code sample above you copied and pasted, after each you used Application.CurCodeMode=False.
Rather than using this repeatedly, I would group all you copy statement together and use Application.CurCodeMode=False onceat the end.

Group all your like statement together
i.e,
Headers
Formula
Copy and Paste

Headers, again you don't need to Select and avoid using ActiveCell.
For example we can do without the code highlighted red.

    Range("AI8").Select
    ActiveCell.FormulaR1C1 = "Unif1"
    Range("AJ8").Select
    ActiveCell.FormulaR1C1 = "Unif2"
    Range("AK8").Select
    ActiveCell.FormulaR1C1 = "Unif3"
    Range("AL8").Select
    ActiveCell.FormulaR1C1 = "Percent Green"
    Range("AM8").Select
    ActiveCell.FormulaR1C1 = "Avg Distance"

And specifically refer to the worksheet the range is on.
Use a With statement.

    With ws
      '========
      'headers
      '========
      .Range("AI8").Value = "Unif1"
      .Range("AJ8").Value = "Unif2"
      .Range("AK8").Value = "Unif3"
      .Range("AL8").Value = "Percent Green"
      .Range("AM8").Value = "Avg Distance"
      .Range("AQ8").Value = "Period"
      .Range("AR8").Value = "Unif1"
      .Range("AS8").Value = "Unif2"
      .Range("AT8").Value = "Unif3"
      .Range("AU8").Value = "Percent Green"
      .Range("AV8").Value = "Average Distance"

As in post 2, I think, rather than using Autofill just place the formula over the full range.
This:

   Range("AA9").Select
    ActiveCell.FormulaR1C1 = "=RC[-5]"
    Range("AA9").Select
    Selection.AutoFill Destination:=Range("AA9:AA13"), Type:=xlFillDefault

Becomes this:

      ws.Range("AA9:AA13").FormulaR1C1 = "=RC[-5]"

Excel will manage incrementing the rows in the formula.

In these two procedures (points 4, 5, in the OP) I would just leave the R1C1 notation in place. You have enough editing to do.

And that's about it. Have a go at tidying up your code. If you still have problems post the specific procedure back here and we will have another look.

Hope all this helps, sorry for all the editing you have to do,
Bertie

ps, You only need one csv file in the workbook to test the changes you make.
If you find a section of code is working as expected, Place a STOP command after it and run the code as normal. When the code STOPS, press F8 to step through the remainder of the code.

 

[nkagar2]

WoW! Just wow! Thank you so much, Bertie for your time and help. This is a great great great starting point for me. Thanks for spoon feeding with detailed explanation. I will get on this today and update you on how it goes. I am so grateful! Thanks again, Bertie!

 

[nkagar2]

So I got through first part of the instruction and got stuck in the second. I commented the "on error to to" to check where the code was breaking and it shows run time error 1004: application-defined or object-defined error for the function get row and highlights this line: GetRowCount = Sheets(sheetName).Range(columnLetter, Rows.count).End(x1Up).Row

Could you please help me with this error? Thanks again for your time and help! Full code is below:

Function GetRowCount(ByVal sheetName As String, _                     ByVal ColumnLetter As String) As Long
                     
   GetRowCount = Sheets(sheetName).Range(ColumnLetter, Rows.count).End(xlUp).Row
End Function
Function DisableApplicationSettings()
   With Application
      .DisplayAlerts = False
      .ScreenUpdating = False
   End With
End Function




Function EnableApplicationSettings()
   With Application
      .DisplayAlerts = True
      .ScreenUpdating = True
   End With
End Function


 
 
 
 
 Sub Two_Avg_Speed_Loop()
   Dim ws As Worksheet
   Dim wbMain As Workbook
   Dim rowCount As Long
   Dim sheetName As String
   
   'On Error GoTo errAvgSpeed  're-enable application settings in event of error
   'DisableApplicationSettings
   
   Set wbMain = ThisWorkbook
   
   For Each ws In wbMain.Worksheets
      If UCase(ws.Name) Like "*.CSV" Then
         
         'Stop
         sheetName = ws.Name
         
         'n1 = average column D
         rowCount = GetRowCount(sheetName, "D")
         ws.Range("N1").Formula = "=Average(D1:D" & rowCount & ")"
         
         '=IF(D1="","",ABS(D1-$N$1))
          ws.Range("O1:O" & rowCount).Formula = "=IF(D1="""","""",ABS(D1-$N$1))"
          
         'P1 = average column O
         rowCount = GetRowCount(sheetName, "O")
         ws.Range("P1").Formula = "=Average(O1:O" & rowCount & ")"
         
         '=IF(O1="","",ABS(O1-$N$1))
         ws.Range("Q1:Q3600").Formula = "=IF(O1="""","""",ABS(O1-$N$1))"
                  
         'R1 = average column Q
         rowCount = GetRowCount(sheetName, "Q")
         ws.Range("R1").Formula = "=Average(Q1:Q" & rowCount & ")"
         
         '=IF(O1="","",ABS(1-O1))
         ws.Range("S1:S3600").Formula = "=IF(O1="""","""",ABS(1-O1))"
         
         'T1 = average column S
         rowCount = GetRowCount(sheetName, "S")
         ws.Range("T1").Formula = "=Average(S1:S" & rowCount & ")"
         
         'Stop




         '============================
         'percent green calculations
         '===========================
         ws.Range("U1").Value = 1
         
         '=IF(M2="",U1,1+U1)
         ws.Range("U2:U3600").Formula = "=IF(M2="""",U1,1+U1)"
         ws.Range("V1:V3600").Formula = "=D1"
         ws.Range("W1").Value = 1
         ws.Range("W2:W20").Formula = "=W1+1"
    
         ws.Range("X1:X3600").FormulaArray = _
             "=MIN(IF((R1C21:R3600C21=RC[-1])*(R1C22:R3600C22<100),R1C22:R3600C22))"
         
         rowCount = GetRowCount(sheetName, "M")
         ws.Range("Y1").Formula = "=COUNTA(M1:M" & rowCount & ")"
         ws.Range("Z1").Formula = "=Y1+1"
         ws.Range("AA1:AA3600").Formula = "=IF(W1>$Z$1,"""",W1)"
         ws.Range("AB1:AB3600").Formula = "=IF(AA1="""","""",X1)"
         
         rowCount = GetRowCount(sheetName, "AB")
         ws.Range("AC1").Formula = "=COUNTIF(AB1:AB" & rowCount & ",0)"
         
         ws.Range("AD1").Formula = "=Y1-AC1"
         ws.Range("AE1").Formula = "=AD1/Y1"
         ws.Range("AE1").NumberFormat = "0.00"
         
         rowCount = GetRowCount(sheetName, "J")
         ws.Range("AF1") = WorksheetFunction.max(ws.Range("J1:J" & rowCount))




      End If
      
   Next ws




errAvgSpeed:
   EnableApplicationSettings




End Sub

 

[bertie]

Yes, there is an error in the function.
It should be
ColumnLetter & Rows.Count

I have used this function for ages, I must have copied from a file that I never tested, sorry. Amended function below.

Function GetRowCount(ByVal sheetName As String, _
                     ByVal ColumnLetter As String) As Long
                     
   GetRowCount = Sheets(sheetName).Range(ColumnLetter & Rows.count).End(xlUp).Row
End Function

 

[nkagar2]

Worked like a charm! Thank you so much!

Yes, there is an error in the function.
It should be
ColumnLetter & Rows.Count

I have used this function for ages, I must have copied from a file that I never tested, sorry. Amended function below.

Function GetRowCount(ByVal sheetName As String, _
                     ByVal ColumnLetter As String) As Long
                     
   GetRowCount = Sheets(sheetName).Range(ColumnLetter & Rows.count).End(xlUp).Row
End Function

 

[nkagar2]

I am also guessing (from my trial runs) that this method of using range().formula does not hold good for range().formulaarray because it copied the first cell formula for all the rows. As always, thank you for your time and help!

[COLOR=#333333]      [/COLOR][COLOR=green]'n1 = average column D[/COLOR]
[COLOR=#ff0000]         rowCount = GetRowCount(sheetName, "D")[/COLOR]         ws.Range("N1").Formula = "=Average(D1:D" & [COLOR=#ff0000]rowCount[/COLOR] & ")"                  [COLOR=green]'=IF(D1="","",ABS(D1-$N$1))[/COLOR] </pre>[COLOR=#333333]          ws.Range([/COLOR][COLOR=#ff0000]"O1:O" & rowCount)[/COLOR][COLOR=#333333].Formula = "=IF(D1="""","""",ABS(D1-$N$1))"[/COLOR]

 

[bertie]

It doesn't look like This approach will work for an array formula.

         ws.Range("X1:X3600").FormulaArray = _
             "=MIN(IF((R1C21:R3600C21=RC[-1])*(R1C22:R3600C22<100),R1C22:R3600C22))"

Produces the formula:

=MIN(IF(($U$1:$U$3600=W1)*($V$1:$V$3600<100),$V$1:$V$3600))

And W1 remains constant as the formula moves down the rows.

This is the only column containing a formula so I would just use the code generated by the Recorder.