3
\$\begingroup\$

This code works perfectly as intended but I am fairly new at VBA and want to learn new techniques and way to optimize my code writing.

It is a very simple process that involves (3) seperate workbooks.

Step 1: Open a .csv, copy a range to the master workbook (wbMacros) and close the workbook.

Step 2: Open another .csv, copy a range to the master workbook and close the workbook.

Step 3: Add some formulas & headers, do some sorting and autofills, and add a column for random shuffling. Very very simple process and simple code for as many lines as it is, hence, why I think that is a more efficient way to write it. Code works great, just looking to make it better.

Any suggestions are welcomed. Thank you.

Sub Open_CSV_Classic()

 Dim strPath As String
 Dim strName As String
 
 Dim wbMacros As Workbook
 Dim wsLineups As Worksheet
 Dim wsData As Worksheet
 Dim wsRaw As Worksheet
 Dim rngPlayerIDList As Range
 Dim rngSourceRange As Range
 Dim rngFillRange As Range
 Dim rngSourceRange2 As Range
 Dim rngFillRange2 As Range
 Dim rngExposureRange As Range
 Dim rngExposureSortRange As Range
 Dim rngToCopyToLineups As Range
 Dim rngAll As Range

 
 Dim wbLineupSet As Workbook
 Dim wsLineupSet As Worksheet
 
 Dim wbPlayerPool As Workbook
 Dim wsPlayerPool As Worksheet
 Dim rngPlayerPool As Range
 
 Dim intMinProj As Integer
 
 Dim rngheaders As Range
 Dim Position As String
 Dim lastrow As Integer
 
 Application.ScreenUpdating = True
 
 'Define wbMacros
 Set wbMacros = Workbooks("Macros_NBA_Asgard_Classic.xlsm")
 Set wsLineups = wbMacros.Sheets("Lineups")
 Set wsData = wbMacros.Sheets("Data")
 Set wsRaw = wbMacros.Sheets("Raw")
 
 'Open the SaberSim Player Pool and copy the pool to wbMacros
 strPath = "C:\Users\safo2\downloads\"
 strName = Dir(strPath & "NBA*.csv")
 Workbooks.Open (strPath & strName)
 Set wbPlayerPool = Workbooks(strName)
 wbPlayerPool.Sheets(1).Name = "Sheet1"
 Set wsPlayerPool = wbPlayerPool.Sheets("Sheet1")
 Set rngPlayerPool = wsPlayerPool.Range("A:BI")
 rngPlayerPool.Copy wsRaw.Cells(1, 1)
 With wsRaw
    Set rngPlayerIDList = wsRaw.Range("A:B")
    rngPlayerIDList.Copy wsData.Range("L1")
 End With
 wbPlayerPool.Close savechanges:=False
 
 'Open the SaberSim Lineup Set and copy the lineups to wbMacros
 strPath = "C:\Users\safo2\downloads\"
 strName = Dir(strPath & "lineups*.csv")
 Set wbOpen = Workbooks.Open(strPath & strName)
 Set wbLineupSet = Workbooks(strName)
 wbLineupSet.Sheets(1).Name = "Sheet1"
 Set wsLineupSet = wbLineupSet.Sheets("Sheet1")
 Set rngLineupSet = wsLineupSet.Range("A:H")
 rngLineupSet.Copy wsData.Range("A:A")
 wbLineupSet.Close savechanges:=False
 
 'Add the exposure to wbMacros
 With wbMacros.Worksheets("Data")
    .Range("N1") = "Pool"
    .Range("N2") = "=COUNTIF($A:$H,L2)"
    .Range("N3") = "=COUNTIF($A:$H,L3)"
    lastrow = wsData.Range("L" & wsData.Rows.Count).End(xlUp).Row
    Set rngSourceRange = .Range("N2:N3")
    Set rngFillRange = .Range("N2", "N" & lastrow)
    rngSourceRange.AutoFill Destination:=rngFillRange, Type:=xlFillDefault
    .Range("O1") = "Percentage"
    .Range("O2") = "=N2/500"
    .Range("O3") = "=N3/500"
    Set rngSourceRange = .Range("O2:O3")
    Set rngFillRange = .Range("O2", "O" & lastrow)
    rngSourceRange.AutoFill Destination:=rngFillRange, Type:=xlFillDefault
    Set rngExposureRange = .Range("L1:O500")
    Set rngExposureSortRange = .Range("N2:N500")
    rngExposureRange.Sort key1:=rngExposureSortRange, order1:=xlDescending, Header:=xlYes
    .Range("I1") = "Random"
    .Range("I2") = "=rand()"
    .Range("I3") = "=rand()"
    lastrow = wsData.Range("H" & wsData.Rows.Count).End(xlUp).Row
    Set rngSourceRange2 = .Range("I2:I3")
    Set rngFillRange2 = .Range("I2", "I" & lastrow)
    rngSourceRange2.AutoFill Destination:=rngFillRange2
    Set rngToCopyToLineups = .Range("A1:I1")
    rngToCopyToLineups.Copy wsLineups.Range("A1")
    Set rngAll = .Range("A:O")
    rngAll.Cells.EntireColumn.AutoFit
 End With
End Sub
\$\endgroup\$
4
  • 1
    \$\begingroup\$ Is all that's missing the Sub procedure declaration and the End Sub token? The code is reviewable as-is, but there could be additional valuable reviewer insight with the full module. \$\endgroup\$ Nov 17, 2022 at 22:27
  • \$\begingroup\$ Yes, the Sub and End Sub are missing but I didn't think that made a huge difference. The Sub is called Open_CSV_Classic. \$\endgroup\$
    – safo2238
    Nov 18, 2022 at 16:05
  • \$\begingroup\$ Is Option Explicit specified at the top of the module? \$\endgroup\$ Nov 18, 2022 at 16:27
  • 1
    \$\begingroup\$ No, it is not. I updated the code to provide the entirety. \$\endgroup\$
    – safo2238
    Nov 18, 2022 at 16:54

1 Answer 1

1
\$\begingroup\$

Best Practice: Always declare Option Explicit at the top of every VBA module. This came up in one of the initial comments. Declaring Option Explicit requires that all variables used in your code are declared more info here . Make it automatic: in the VBIDE, check the 'Tools -> Options... -> (Editor tab) Require Variable Declaration' option.

Best Practice: Within Subroutines and Functions, declare local variables close to their initial use.

Two most important software principles to improve your code: Single Responsibility Principle (SRP) Don't Repeat Yourself Principle (DRY)

SRP, in a nutshell, advocates that all methods (Subroutines and Functions) should have a single responsibility. In the posted code, there is a single Sub that fulfills four responsibilities:

  1. Acts as an entry point for executing the code
  2. Copies Player pool information to the wbMacros workbook
  3. Copies Lineup information to to the wbMacros workbook
  4. 'Add the exposure to wbMacros' - not sure what this means

SRP will result in helper functions that replace long block of code (responsibilities). The result is code that is easier to read and maintain.

Other than the first responsibility, items 2 - 4 above are based on comments found in the code. And, when writing code, if one feels compelled to comment on what a block of code does, then it is typically better to replace that comment with a helper method. Let the helper method's name make the comment unnecessary.

First Pass refactoring:

Applying the two best practices identified above and SRP based on the comments results in:

Option Explicit

Sub Open_CSV_Classic()
    
    Dim intMinProj As Integer
    
    Dim rngheaders As Range
    Dim Position As String
    
    Application.ScreenUpdating = True
    
    'Define wbMacros
    Dim wbMacros As Workbook
    Set wbMacros = Workbooks("Macros_NBA_Asgard_Classic.xlsm")
    
    Dim wsData As Worksheet
    Set wsData = wbMacros.Sheets("Data")
    
    CopyPlayerPoolDataToMacrosWorkbook wbMacros, wsData
     
    CopyLineupsDataToMacrosWorkbook wbMacros, wsData
    
    AddTheExposureToWbMacros wbMacros
    
    End Sub

Private Sub CopyPlayerPoolDataToMacrosWorkbook(ByVal wbMacros As Workbook, ByVal wsData As Worksheet)
    
    Dim strPath As String
    strPath = "C:\Users\safo2\downloads\"
    
    Dim strName As String
    strName = Dir(strPath & "NBA*.csv")
    
    Workbooks.Open (strPath & strName)
    
    Dim wbPlayerPool As Workbook
    Set wbPlayerPool = Workbooks(strName)
    wbPlayerPool.Sheets(1).Name = "Sheet1"
    
    Dim wsPlayerPool As Worksheet
    Set wsPlayerPool = wbPlayerPool.Sheets("Sheet1")
    
    Dim rngPlayerPool As Range
    Set rngPlayerPool = wsPlayerPool.Range("A:BI")
    
    Dim wsRaw As Worksheet
    Set wsRaw = wbMacros.Sheets("Raw")
    rngPlayerPool.Copy wsRaw.Cells(1, 1)
    
    Dim rngPlayerIDList As Range
    Set rngPlayerIDList = wsRaw.Range("A:B")
    rngPlayerIDList.Copy wsData.Range("L1")
    
    wbPlayerPool.Close savechanges:=False
End Sub

Private Sub CopyLineupsDataToMacrosWorkbook(ByVal wbMacros As Workbook, ByVal wsData As Worksheet)
    
    Dim strPath As String
    strPath = "C:\Users\safo2\downloads\"
    
    Dim strName As String
    strName = Dir(strPath & "lineups*.csv")
    
    Dim wbLineupSet As Workbook
    Set wbLineupSet = Workbooks(strName)
    wbLineupSet.Sheets(1).Name = "Sheet1"
    
    Dim wsLineupSet As Worksheet
    Set wsLineupSet = wbLineupSet.Sheets("Sheet1")
    
    Dim rngLineupSet As Range
    Set rngLineupSet = wsLineupSet.Range("A:H")
    rngLineupSet.Copy wsData.Range("A:A")
    
    wbLineupSet.Close savechanges:=False
End Sub

Private Sub AddTheExposureToWbMacros(ByVal wbMacros As Workbook)
    
    Dim wsData As Worksheet
    Set wsData = wbMacros.Sheets("Data")
    
    Dim wsLineups As Worksheet
    Set wsLineups = wbMacros.Sheets("Lineups")
    
    With wbMacros.Worksheets("Data")
        .Range("N1") = "Pool"
        .Range("N2") = "=COUNTIF($A:$H,L2)"
        .Range("N3") = "=COUNTIF($A:$H,L3)"
        
        Dim lastrow As Long
        lastrow = wsData.Range("L" & wsData.Rows.Count).End(xlUp).Row
        
        Dim rngSourceRange As Range
        Set rngSourceRange = .Range("N2:N3")
        
        Dim rngFillRange As Range
        Set rngFillRange = .Range("N2", "N" & lastrow)
        
        rngSourceRange.AutoFill Destination:=rngFillRange, Type:=xlFillDefault
        .Range("O1") = "Percentage"
        .Range("O2") = "=N2/500"
        .Range("O3") = "=N3/500"
        Set rngSourceRange = .Range("O2:O3")
        Set rngFillRange = .Range("O2", "O" & lastrow)
        rngSourceRange.AutoFill Destination:=rngFillRange, Type:=xlFillDefault
        
        Dim rngExposureRange As Range
        Set rngExposureRange = .Range("L1:O500")
        
        Dim rngExposureSortRange As Range
        Set rngExposureSortRange = .Range("N2:N500")
        rngExposureRange.Sort key1:=rngExposureSortRange, order1:=xlDescending, Header:=xlYes
        .Range("I1") = "Random"
        .Range("I2") = "=rand()"
        .Range("I3") = "=rand()"
        lastrow = wsData.Range("H" & wsData.Rows.Count).End(xlUp).Row
        
        Dim rngSourceRange2 As Range
        Set rngSourceRange2 = .Range("I2:I3")
        
        Dim rngFillRange2 As Range
        Set rngFillRange2 = .Range("I2", "I" & lastrow)
        rngSourceRange2.AutoFill Destination:=rngFillRange2
        
        Dim rngToCopyToLineups As Range
        Set rngToCopyToLineups = .Range("A1:I1")
        rngToCopyToLineups.Copy wsLineups.Range("A1")
        
        Dim rngAll As Range
        Set rngAll = .Range("A:O")
        rngAll.Cells.EntireColumn.AutoFit
    End With

End Sub

Based only on re-arranging the code, the following improvements to Open_CSV_Classic can be seen:

  1. The lengthy 'wall' of declarations (Dim statements) is gone. The reader is met, with executable code statements that describe at a high-level what Open_CSV_Classic does. There is no longer any need for comments as the function calls describe what is happening.
  2. Declarations for intMinProj, rngheaders, and Position are never used...and it becomes obvious because the previous long list of declarations have been distributed to where they are used.

Second Pass refactoring

Best Practice: Replace the use of raw strings (e.g., "C:\Users\safo2\downloads") with constants or module level fields. This is especially important for file path related strings. Using constants and fields reduces/avoids typos. And, when a value needs to change in the future (and it will)...it is only necessary to make an update in one place.

DRY advocates for the elimination of duplicated code. Reducing duplicated code improves code quality and makes the code easier to maintain. DRY reduces mistakes when code is written using the following process:

  1. Write code
  2. Copy/paste the block of code from #1 and change one or two values or variable names
  3. Repeat step #2 as needed

Subroutines CopyPlayerPoolDataToMacrosWorkbook and CopyLineupsDataToMacrosWorkbook have a fair amount of code that looks very similar. The similar code can be refactored into a helper function(s) to reduce repeated code.

There are opportunities in AddTheExposureToWbMacros as well. The With block contains a couple Range variables: rngSourceRange and rngSourceRange2. The need to create a nearly-identical variable with a numeric suffix is indicative of code that has been created the using copy/paste processes above.

Removing (most) raw strings and applying DRY on CopyPlayerPoolDataToMacrosWorkbook and CopyLineupsDataToMacrosWorkbook results in:

Option Explicit

Private Const MacroWorkbookName As String = "Macros_NBA_Asgard_Classic.xlsm"
Private Const MacroWorkbookDataSheetName As String = "Data"

Private Const DownloadsFolderpath As String = "C:\Users\safo2\downloads\"
Private Const PlayerPoolFilenameWildcard As String = "NBA*.csv"
Private Const LineupsFilenameWildcard As String = "lineups*.csv"
Private Const LinupsSheetName As String = "Lineups"

Sub Open_CSV_Classic()
    
    Application.ScreenUpdating = True
    
    Dim wbMacros As Workbook
    Set wbMacros = Workbooks(MacroWorkbookName)
    
    Dim wsData As Worksheet
    Set wsData = wbMacros.Sheets(MacroWorkbookDataSheetName)
    
    CopyPlayerPoolDataToMacrosWorkbook wbMacros, wsData
     
    CopyLineupsDataToMacrosWorkbook wbMacros, wsData
    
    AddTheExposureToWbMacros wbMacros
    
    End Sub

Private Sub CopyPlayerPoolDataToMacrosWorkbook(ByVal wbMacros As Workbook, ByVal wsData As Worksheet)
    
    Dim wbPlayerPool As Workbook
    Set wbPlayerPool = GetPreparedWorkbook(DownloadsFolderpath & PlayerPoolFilenameWildcard)
    
    Dim rngPlayerPool As Range
    Set rngPlayerPool = GetRangeOfInteret(wbPlayerPool, "Sheet1", "A:BI")
    
    Dim wsRaw As Worksheet
    Set wsRaw = wbMacros.Sheets("Raw")
    rngPlayerPool.Copy wsRaw.Cells(1, 1)
    
    Dim rngPlayerIDList As Range
    Set rngPlayerIDList = wsRaw.Range("A:B")
    rngPlayerIDList.Copy wsData.Range("L1")
    
    wbPlayerPool.Close savechanges:=False
End Sub

Private Sub CopyLineupsDataToMacrosWorkbook(ByVal wbMacros As Workbook, ByVal wsData As Worksheet)
    
    Dim wbLineupSet As Workbook
    Set wbLineupSet = GetPreparedWorkbook(DownloadsFolderpath & LineupsFilenameWildcard)
    
    Dim rngLineupSet As Range
    Set rngLineupSet = GetRangeOfInteret(wbLineupSet, "Sheet1", "A:H")
    
    rngLineupSet.Copy wsData.Range("A:A")
    
    wbLineupSet.Close savechanges:=False
End Sub

Private Function GetPreparedWorkbook(ByVal workbookPath As String) As Workbook
    
    Dim wrkBook As Workbook
    Set wrkBook = Workbooks(workbookPath)
    wrkBook.Sheets(1).Name = "Sheet1"
    
    Set GetPreparedWorkbook = wrkBook
End Function

Private Function GetRangeOfInterest(ByVal wrkBook As Workbook, ByVal sheetName As String, ByVal rangeExpression As String) As Range
    
    Dim wrkSheet As Worksheet
    Set wrkSheet = wrkBook.Sheets(sheetName)
    
    Set GetRangeOfInterest = wrkSheet.Range(rangeExpression)

End Function

Private Sub AddTheExposureToWbMacros(ByVal wbMacros As Workbook)
    
    Dim wsData As Worksheet
    Set wsData = wbMacros.Sheets(MacroWorkbookDataSheetName)
    
    Dim wsLineups As Worksheet
    Set wsLineups = wbMacros.Sheets(LinupsSheetName)
    
    With wbMacros.Worksheets(MacroWorkbookDataSheetName)
        .Range("N1") = "Pool"
        .Range("N2") = "=COUNTIF($A:$H,L2)"
        .Range("N3") = "=COUNTIF($A:$H,L3)"
        
        Dim lastrow As Long
        lastrow = wsData.Range("L" & wsData.Rows.Count).End(xlUp).Row
        
        Dim rngSourceRange As Range
        Set rngSourceRange = .Range("N2:N3")
        
        Dim rngFillRange As Range
        Set rngFillRange = .Range("N2", "N" & lastrow)
        
        rngSourceRange.AutoFill Destination:=rngFillRange, Type:=xlFillDefault
        .Range("O1") = "Percentage"
        .Range("O2") = "=N2/500"
        .Range("O3") = "=N3/500"
        Set rngSourceRange = .Range("O2:O3")
        Set rngFillRange = .Range("O2", "O" & lastrow)
        rngSourceRange.AutoFill Destination:=rngFillRange, Type:=xlFillDefault
        
        Dim rngExposureRange As Range
        Set rngExposureRange = .Range("L1:O500")
        
        Dim rngExposureSortRange As Range
        Set rngExposureSortRange = .Range("N2:N500")
        rngExposureRange.Sort key1:=rngExposureSortRange, order1:=xlDescending, Header:=xlYes
        .Range("I1") = "Random"
        .Range("I2") = "=rand()"
        .Range("I3") = "=rand()"
        lastrow = wsData.Range("H" & wsData.Rows.Count).End(xlUp).Row
        
        Dim rngSourceRange2 As Range
        Set rngSourceRange2 = .Range("I2:I3")
        
        Dim rngFillRange2 As Range
        Set rngFillRange2 = .Range("I2", "I" & lastrow)
        rngSourceRange2.AutoFill Destination:=rngFillRange2
        
        Dim rngToCopyToLineups As Range
        Set rngToCopyToLineups = .Range("A1:I1")
        rngToCopyToLineups.Copy wsLineups.Range("A1")
        
        Dim rngAll As Range
        Set rngAll = .Range("A:O")
        rngAll.Cells.EntireColumn.AutoFit
    End With

End Sub

Hopefully the above information and changes are the kind of feedback you were looking for. Good luck!

\$\endgroup\$
6
  • \$\begingroup\$ Hello BZngr. This was excellent information and will take me some time to digest. I am struggling to figure out where the ByVal workbookPath is defined? It is giving me a Subscript out of Range error. \$\endgroup\$
    – safo2238
    Nov 28, 2022 at 20:20
  • \$\begingroup\$ I think the statement Set wrkBook = Workbooks(workbookPath) should be Set wrkBook = Workbooks.Open(workbookPath) in function GetPreparedWorkbook. workbookPath is only defined as a parameter. Based on the originally posted code (workbookPath should equal "C:\Users\safo2\downloads\NBA*.csv", or "C:\Users\safo2\downloads\lineups*.csv"). \$\endgroup\$
    – BZngr
    Nov 28, 2022 at 20:56
  • \$\begingroup\$ Where does the workbookpath get passed into? Also, in the GetPreparedWorkbook the strName = Dir(DownloadsFolderpath & LineupsFilenameWildcard) will always have the LineupsFilenameWildcard and will never have the PlayerPoolFilenameWildcard correct? \$\endgroup\$
    – safo2238
    Nov 28, 2022 at 21:15
  • \$\begingroup\$ workbookPath gets passed into GetPreparedWorkbook. The statement strName = Dir(DownloadsFolderpath & LineupsFilenameWildcard) should have been deleted...it was not intended to be left in GetPreparedWorkbook...as you can see, strName is never used. (it's been deleted) \$\endgroup\$
    – BZngr
    Nov 29, 2022 at 2:18
  • \$\begingroup\$ I still get the "Subscript out of Range" error for the Set wrkBook = Workbooks(workbookPath) because workbookPath is = to C:\users\safo2\downloads\NBA*.csv. Shouldn't it be equal to the actual workbook name? \$\endgroup\$
    – safo2238
    Nov 29, 2022 at 14:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.