1

I have a script I use that goes down a column in a second worksheet and pulls only the managers (their employees data) that I specify.

It takes about .8-.9 seconds for each file to form from both arrays (one for storing and the second for a faster printing to a new wb)

Are there any revisions you would make in order to drastically speed it up? I know that the majority of the time spent is saving/password protecting.

script: 

Option Explicit

Sub HR_Assessment()
Dim j As Long, k As Long, x As Long ' counters
Dim varArray() As Variant
Dim varArray2() As Variant
ReDim varArray(1 To 75, 1 To 1)

Dim strManager As String
Dim BASEPATH As String, strNewPath As String, strFileName As String
Dim Wb As Workbook

Dim mgrRow As Long ' counter
Dim colManager As Long ' the column manager appears in
colManager = 1

BASEPATH = "M:\Raw Reports\HR\"

Call Ludicrous(True) - this is just a separate module that turns off calculations/screen updating/etc....

For mgrRow = 2 To ThisWorkbook.Worksheets("Mgrs").UsedRange.Rows.Count
    If ThisWorkbook.Worksheets("Mgrs").Cells(mgrRow, 1) <> "" Then
        strManager = ThisWorkbook.Worksheets("Mgrs").Cells(mgrRow, 1)

        With ThisWorkbook.Worksheets("Sheet1")
            ReDim varArray(1 To UBound(varArray, 1), 1 To 1)
            x = 1
            For k = 1 To UBound(varArray, 1)
                varArray(k, x) = .Cells(1, k)
            Next
            For j = 1 To .UsedRange.Rows.Count + 1
                If strManager = .Cells(j, colManager) Then
                    x = x + 1
                    ReDim Preserve varArray(1 To UBound(varArray, 1), 1 To x)
                    For k = 1 To UBound(varArray, 1)

                            varArray(k, x) = .Cells(j, k)

                        strManager = .Cells(j, colManager)
                    Next
                End If
            Next
        End With

        strNewPath = BASEPATH & "11.01.18" & "\"
        If Len(Dir(strNewPath, vbDirectory)) = 0 Then
            MkDir strNewPath
        End If
        ' Path is now "constant path" 


        strFileName = strManager & " - " & "HR_Assessment" & ".xlsx"

        ReDim varArray2(1 To UBound(varArray, 2), 1 To UBound(varArray, 1))

        Set Wb = Workbooks.Add(XlWBATemplate.xlWBATWorksheet)
        With Wb
            With .Worksheets("Sheet1")
                For j = 1 To UBound(varArray, 2)
                    For k = 1 To UBound(varArray, 1)
                        varArray2(j, k) = varArray(k, j)
                    Next
                Next

                .Range(.Cells(1, 1), .Cells(UBound(varArray, 2), UBound(varArray, 1))) = varArray2
                .Range("A:B").Columns.AutoFit

            End With

            .SaveAs strNewPath & strFileName, Password:="password", FileFormat:=51
            .Saved = True
            .Close

        End With
        Set Wb = Nothing
    End If
Next

Call Ludicrous(False)

End Sub
0m3r
  • 12,286
  • 15
  • 35
  • 71
nick lanta
  • 602
  • 3
  • 10
  • 1
    Maybe this is a good start and see how much you can reduce, [How To Speed Up VBA Code](https://stackoverflow.com/questions/47089741/how-to-speed-up-vba-code) – Wizhi Nov 01 '18 at 15:36
  • 7
    [Code Review](https://codereview.stackexchange.com/) is a better place to ask for improvements to code. You also seem to be referencing cells a fair amount and stepping through rows where column A isn't blank - may be faster to filter the sheet by column A and then copy the visible cells into an array so you only read from the sheet once and put the values back once. – Darren Bartrup-Cook Nov 01 '18 at 15:43
  • @Wizhi I'd take most of those with a grain of salt. There isn't a "magic bullet" for performance. – Comintern Nov 01 '18 at 15:43
  • 1
    @Comintern, I agree. I just noticed he didn't use any of them. All small pieces adds up :P. But you are correct, the most important is an effective code/structure and that's not very easy to achieve :). – Wizhi Nov 01 '18 at 15:47
  • 2
    @Wizhi `Call Ludicrous(True) - this is just a separate module that turns off calculations/screen updating/etc....` - I presume this does exactly that. The solution to inefficient code isn't to reduce the host app overhead (although it can help)... the solution is to write more efficient code. – Mathieu Guindon Nov 01 '18 at 16:05
  • 1
    @MathieuGuindon correct, it's a byval toggle as Boolean sub that turns off screen updating, enable events, display alerts, enable animations, display status bar, and calculations. – nick lanta Nov 01 '18 at 16:07
  • @DarrenBartrup-Cook are you talking about filtering by column A in sheet 1, and then using that data to form an array to print to the new worksheet? – nick lanta Nov 01 '18 at 16:08
  • 2
    I'd suggest renaming it to a more meaningful identifier that starts with a verb and hints at its purpose, rather than using a funny moniker that requires a long distracting comment to reveal what it does. – Mathieu Guindon Nov 01 '18 at 16:11
  • Yes, but on looking further passing a filtered range straight to an array only seems to add the first `area` to the array: `vArray = Sheet1.Range("A1:A22").SpecialCells(xlCellTypeVisible)`, but you could copy the filtered range to a blank area and then add to an array: `Sheet1.Range("A1:A22").SpecialCells(xlCellTypeVisible).Copy Sheet2.Range("A1"): vArray = Sheet2.Range("A1:A14").SpecialCells(xlCellTypeVisible)` (you don't actually need the `SpecialCells` bit and you'd need to work out where the end of the new range is). Not sure if this would make if faster now :) – Darren Bartrup-Cook Nov 01 '18 at 16:30

0 Answers0