5
\$\begingroup\$

I'm an intern in an industrial company in Brazil and it happens that I'm using excel a lot. I just started playing with VBA couple of days ago, and I'm amused of how many things it can do for me!

I don't have a strong programming background, so I'm learning by doing. The code is working fine and it takes less than 15 seconds from start to finish. I'm not that concerned with the time, but if it could be improved that'd be great.

My main goal is to keep the code simple and efficient. I'll be leaving the company in the next months and I'd like it to be easy to maintain and use. What I'm asking is a better way to write readable code, with performance as a secondary concern.

My code delete 4 sheets of content in my current workbook, and then copies the updated data from 4 other closed workbooks. Then it closes everything. The data is about the daily production and their names are in Portuguese, sorry about that.

Sub CopiarBase()

'
' Atalho do teclado: Ctrl+q
'


    ' Variables
    Dim MyCurrentWB As Workbook
    Dim BMalharia As Worksheet
    Dim BBeneficiamento As Worksheet
    Dim BEmbalagem As Worksheet
    Dim BDikla As Worksheet

    Set MyCurrentWB = ThisWorkbook
    Set BMalharia = MyCurrentWB.Worksheets("B-Malharia")
    Set BBeneficiamento = MyCurrentWB.Worksheets("B-Beneficiamento")
    Set BEmbalagem = MyCurrentWB.Worksheets("B-Embalagem")
    Set BDikla = MyCurrentWB.Worksheets("B-Dikla")

    'Clean all the cells - Workbook 1


    Dim Malharia_rng As Range
    Set Malharia_rng = BMalharia.Range("A2:CN" & BMalharia.Cells(Rows.Count, 1).End(xlUp).Row)
    Malharia_rng.ClearContents

    Dim Ben_rng As Range
    Set Ben_rng = BBeneficiamento.Range("A2:CY" & BBeneficiamento.Cells(Rows.Count, 1).End(xlUp).Row)
    Ben_rng.ClearContents

    Dim Emb_rng As Range
    Set Emb_rng = BEmbalagem.Range("A2:CT" & BEmbalagem.Cells(Rows.Count, 1).End(xlUp).Row)
    Emb_rng.ClearContents

    Dim Dikla_rng As Range
    Set Dikla_rng = BDikla.Range("A2:AV" & BDikla.Cells(Rows.Count, 1).End(xlUp).Row)
    Dikla_rng.ClearContents


    'Copy from Malharia Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Malharia Base.xls"

    LastRowMB = Workbooks("Malharia Base.xls").Worksheets("Malharia Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Malha_base As Range
    Set Malha_base = Workbooks("Malharia Base.xls").Worksheets("Malharia Base").Range("A2:CN" & LastRowMB)

    MyCurrentWB.Worksheets("B-Malharia").Range("A2:CN" & LastRowMB).Value = Malha_base.Value
    Workbooks("Malharia Base.xls").Close

    'Copy from Beneficiamento Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Beneficiamento Base.xls"

    LastRowBB = Workbooks("Beneficiamento Base.xls").Worksheets("Beneficiamento Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Ben_base As Range
    Set Ben_base = Workbooks("Beneficiamento Base.xls").Worksheets("Beneficiamento Base").Range("A2:CY" & LastRowBB)

    MyCurrentWB.Worksheets("B-Beneficiamento").Range("A2:CY" & LastRowBB).Value = Ben_base.Value
    Workbooks("Beneficiamento Base.xls").Close

    'Copy from Embalagem Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Embalagem Base.xls"

    LastRowEB = Workbooks("Embalagem Base.xls").Worksheets("Embalagem Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Emb_base As Range
    Set Emb_base = Workbooks("Embalagem Base.xls").Worksheets("Embalagem Base").Range("A2:CT" & LastRowEB)

    MyCurrentWB.Worksheets("B-Embalagem").Range("A2:CT" & LastRowEB).Value = Emb_base.Value
    Workbooks("Embalagem Base.xls").Close

    'Copy from Dikla Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Diklatex Base.xls"

    LastRowDB = Workbooks("Diklatex Base.xls").Worksheets("Diklatex Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Dikla_base As Range
    Set Dikla_base = Workbooks("Diklatex Base.xls").Worksheets("Diklatex Base").Range("A2:AV" & LastRowDB)

    MyCurrentWB.Worksheets("B-Dikla").Range("A2:AV" & LastRowDB).Value = Dikla_base.Value
    Workbooks("Diklatex Base.xls").Close

End Sub
\$\endgroup\$
1

3 Answers 3

4
\$\begingroup\$

An idea for you:

Right now, your code is assuming all sorts of things about worksheets in other workbooks including, but not limited to:

  • The names of the other workbooks' worksheets
  • The location of the data within those sheets

If any of those workbooks change you'll have to go through every macro that interacts with them and change all the details. This is a huge source of errors and data corruption.

Instead, each of your (other) workbooks should have an internal Macro to export sheet data. That way, if something in your other workbooks changes, you can change the code there, and every other workbook that needs the data won't need to be re-written.

As an example, this is some code from my last VBA project with example usage:


From any other workbook that wants the data:

Sub test()

    Dim wbTarget as Workbook
    Set wbTarget = [Workbook Ref]    

    Dim targetCodeName As String
    wbTarget.GetSubsheetCodeNames newClientCodename:=targetCodeName 

    Dim arr As Variant
    arr = wbTarget.GetDataArrayFromSheetByCodename(targetCodeName)

End Sub

In the workbook containing the data:

Option Explicit

Public Const ADVISER_HEADER As String = "Adviser"

Public Sub GetSubsheetCodeNames( _
            Optional ByRef newClientCodename As String _
            , Optional ByRef existingClientCodename As String _
            , Optional ByRef otherInitialCodename As String _
            , Optional ByRef groupSchemesCodename As String _
            , Optional ByRef clientWithdrawalsCodename As String)

    newClientCodename = wsNewClient.CodeName
    existingClientCodename = wsExistingClient.CodeName
    otherInitialCodename = wsOtherInitial.CodeName
    groupSchemesCodename = wsGroupSchemes.CodeName
    clientWithdrawalsCodename = wsClientWithdrawals.CodeName

End Sub

Public Function GetDataArrayFromSheetByCodename(ByVal wsCodename As String) As Variant
    '/ returns the dataArray, or an error if could not find worksheet

    Dim dataArray As Variant
        dataArray = Array()

    Dim wsWasFound As Boolean
    Dim wsTarget As Worksheet, ws As Worksheet

    wsWasFound = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.CodeName = wsCodename Then
            Set wsTarget = ws
            wsWasFound = True
            Exit For
        End If
    Next ws

    Dim topLeftCellText As String
    topLeftCellText = GetWsTopLeftCellText(wsTarget)

    Dim tableRange As Range
    If wsWasFound Then
            dataArray = GetWsDataArray(ThisWorkbook, wsTarget, topLeftCellText, useCurrentRegion:=False)
            GetDataArrayFromSheetByCodename = dataArray
        Else
            GetDataArrayFromSheetByCodename = CVErr(2042) '/ #N/A error
    End If

End Function

Private Function GetWsTopLeftCellText(ByRef ws As Worksheet) As String

    Dim topLeftCellText As String
    Select Case ws.CodeName

        Case Is = "wsNewClient"
            topLeftCellText = ADVISER_HEADER

        Case Is = "wsExistingClient"
            topLeftCellText = ADVISER_HEADER

        Case Is = "wsOtherInitial"
            topLeftCellText = ADVISER_HEADER

        Case Is = "wsGroupSchemes"
            topLeftCellText = ADVISER_HEADER

        Case Is = "wsClientWithdrawals"
            topLeftCellText = ADVISER_HEADER

        Case Else
        '/ TODO: Add Error handling
            Stop

    End Select
    GetWsTopLeftCellText = topLeftCellText

End Function

Public Function GetWsDataArray(ByRef wbTarget As Workbook, ByRef wsTarget As Worksheet, ByVal topLeftCellText As String, ByVal useCurrentRegion As Boolean _
                            , Optional ByVal searchStartRow As Long = 1, Optional ByVal searchStartColumn As Long = 1 _
                            , Optional ByVal searchEndRow As Long = 10, Optional ByVal searchEndColumn As Long = 10) As Variant
                            '/ 10x10 is arbitrary search range that should cover almost all typical worksheets

    Dim dataArray As Variant
        dataArray = Array()
        dataArray = GetWsDataRange(wbTarget, wsTarget, topLeftCellText, useCurrentRegion, searchStartRow, searchStartColumn, searchEndRow, searchEndColumn)

        GetWsDataArray = dataArray

End Function

Public Function GetWsDataRange(ByRef wbTarget As Workbook, ByRef wsTarget As Worksheet, ByVal topLeftCellText As String, ByVal useCurrentRegion As Boolean _
                            , ByVal searchStartRow As Long, ByVal searchStartColumn As Long _
                            , ByVal searchEndRow As Long, ByVal searchEndColumn As Long) As Range

    Dim wbSource As Workbook, wsSource As Worksheet
    Set wbSource = ActiveWorkbook
    Set wsSource = ActiveSheet

    wbTarget.Activate
    wsTarget.Activate
    ShowAllWsCells wsTarget

    Dim topLeftCell As Range, searchRange As Range, dataRange As Range
    Set searchRange = wsTarget.Range(Cells(searchStartRow, searchStartColumn), Cells(searchEndRow, searchEndColumn))
    Set topLeftCell = CellContainingStringInRange(searchRange, topLeftCellText)

    Dim lastRow As Long, lastCol As Long
    If useCurrentRegion Then
        Set dataRange = topLeftCell.CurrentRegion
    Else
        lastRow = Cells(Rows.Count, topLeftCell.Column).End(xlUp).Row
        lastCol = Cells(topLeftCell.Row, Columns.Count).End(xlToLeft).Column
        Set dataRange = wsTarget.Range(topLeftCell, Cells(lastRow, lastCol))
    End If

    Set GetWsDataRange = dataRange
    wbSource.Activate
    wsSource.Activate

End Function

Public Function CellContainingStringInRange(ByRef rngSearch As Range, ByVal strSearch As String) As Range

    Dim errorMessage As String

    Set CellContainingStringInRange = rngSearch.Find(strSearch, LookIn:=xlValues)
    If CellContainingStringInRange Is Nothing _
        Then
            errorMessage = "Couldn't find cell """ & strSearch & """ in " & rngSearch.Worksheet.name
            PrintErrorMessage errorMessage, stopExecution:=True
    End If

End Function

Public Sub ShowAllWsCells(ByRef ws As Worksheet)

    ws.Rows.Hidden = False
    ws.Columns.Hidden = False
    ws.AutoFilterMode = False

End Sub

As you can see, the workbook containing the data knows all sorts of information about how to locate the data that the other workbooks do not need to know.

If it changes, you only have to change the information in the workbook that changed.

Any other workbook that wants the data can just ask for it, and let the target handle the details.

Also,


Codenames

Codenames are big and clever. Every worksheet and workbook has a "name" that the user can see and change.

MyCurrentWB.Worksheets("B-Dikla")

is referencing a sheet name.

A Codename on the other hand is a secret name that can only be set/changed in the IDE.

enter image description here

the name in brackets is the "name". The name not in brackets is the "codename". It is set in the properties window.

enter image description here

If you give a sheet a codename (E.G. "wsBDikla") then the user can change the name as much as they like, all you have to do is use

wsBDikla.ClearContents

in your code and it will keep running.

\$\endgroup\$
3
  • \$\begingroup\$ Thank you very much, @Zak! I'll take sometime to digest so much information, but it will be super helpful. What I've done so far was change the current "Clean all the cells" to 4 lines like these: wsBDikla.Range("A2:AV" & BDikla.Cells(Rows.Count, 1).End(xlUp).Row).ClearContents \$\endgroup\$ Jan 20, 2016 at 16:50
  • \$\begingroup\$ One problem that I see in your approach, is that the source files are always overwritten by a system and I don't have control over this. So, I can't have code on them. Anyway, this will help me in another project that I have! \$\endgroup\$ Jan 20, 2016 at 17:09
  • \$\begingroup\$ @mschlindwein Ah, well then I guess it can't be helped. I'm glad you can still find a use for it. \$\endgroup\$
    – Kaz
    Jan 20, 2016 at 21:16
4
\$\begingroup\$

My main goal is to keep the code simple and efficient. I'll be leaving the company in the next months and I'd like it to be easy to maintain and use. What I'm asking is a better way to write readable code, with performance as a secondary concern.

In all manner of repeated processes with minimal variations of a few names and/or addresses, loops and arrays are your friend. You are essentially using three (well... two and a file extension) parameters for each nearly identical process. By loading these into an array and cycling through the array your code becomes significantly more localized; greatly reducing the actual number of code lines. The added benefit is that even minor modifications need only be performed once and mistakes are not multiplied by copying and pasting sections of code. The only detriment to this method is if you get paid by the code line.

There simply isn't enough attention paid to the benefits of implementing nested With ... End With statements to provide parentage to cells and worksheets. Not only does it (to my eye) make code easier to read by reducing clutter but it speeds up code execution by retaining a parent reference and not reestablishing it line-after-line.

Sub CopiarBase()
    ' Atalho do teclado: Ctrl+q
    ' Variables
    Dim fp As String, w As Long, vWSs As Variant, vTMP As Variant

    fp = "C:\Users\marco.henrique\Desktop\Bases\"

    vWSs = Array("B-Malharia", "Malharia Base.xls", "Malharia Base", _
                 "B-Beneficiamento", "Beneficiamento Base.xls", "Beneficiamento Base", _
                 "B-Embalagem", "Embalagem Base.xls", "Embalagem Base", _
                 "B-Dikla", "Diklatex Base.xls", "Diklatex Base")

    With ThisWorkbook
        For w = LBound(vWSs) To UBound(vWSs) Step 3
            With .Worksheets(vWSs(w))
                'Clean all the cells
                With .Cells(1, 1).CurrentRegion
                    .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).ClearContents
                End With

                'open the matching workbook
                With Workbooks.Open(Filename:=fp & vWSs(w + 1), ReadOnly:=True)
                    'put all the cells' values into an array
                    With .Worksheets(vWSs(w + 2)).CurrentRegion
                        vTMP = .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Value
                    End With
                    .Close SaveChanges:=False
                End With

                'pass the stored values back
                .Cells(2, 1).Resize(UBound(vTMP, 1), UBound(vTMP, 2)) = vTMP
            End With
        Next w
    End With

End Sub

I've used the Range.CurrentRegion property to isolate the block or 'island' of cells that radiates out from A1. This is a bit of a guess as you had them referred to in slightly different range sizes (e.g. A:CN, A:CY, A:CT and A:AV). This would have to be reworked if there actually were completely blank columns or rows.

If these workbooks are reasonably large (e.g. >25K rows) you would see an appreciable decrease in file size (and subsequent load-time) if you could create them as Binary Workbooks (*.xlsb). The .xls extension suggests to me that they are created by an older outside process but a binary workbook format should remain a future consideration. Small filesize (typically 30% of a similar .xlsx or .xlsm) means faster load times and (marginally) faster calculation.

\$\endgroup\$
3
\$\begingroup\$

So, here's the deal with getting data from closed workbooks... you don't actually have to open them.

Add a reference to the ADODB library and use it to query the workbooks as data sources. A bit of searching "use ADODB to query Excel worksheet" should put you onto a much faster solution. The hard part will be getting the connection strings right, and learning the funky Excel/SQL syntax for querying.

This is faster because the workbook never has to be loaded into an instance of Excel. It's read directly from file.

\$\endgroup\$
4
  • \$\begingroup\$ This sounds very big and very clever. Will have to look into it ^^ \$\endgroup\$
    – Kaz
    Feb 4, 2016 at 11:30
  • \$\begingroup\$ It's easy peasy once you've done it once @Zak. It is very clever I suppose (the good kind of clever) and well worth learning the technique. \$\endgroup\$
    – RubberDuck
    Feb 4, 2016 at 12:29
  • \$\begingroup\$ Does this mean I can read the files' contents while it's open on somebody else's computer? Because that would be really awesome. \$\endgroup\$
    – Kaz
    Feb 4, 2016 at 12:30
  • \$\begingroup\$ I'm not sure about that @Zak. I don't see why not, but I don't know. \$\endgroup\$
    – RubberDuck
    Feb 4, 2016 at 12:32

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.