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
Jamal
35.2k13 gold badges134 silver badges238 bronze badges
asked Jan 20, 2016 at 15:42
\$\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.

answered Jan 20, 2016 at 16:18
\$\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\$ Commented 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\$ Commented 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\$ Commented 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.

answered Jan 20, 2016 at 21:59
\$\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.

answered Jan 21, 2016 at 0:58
\$\endgroup\$
4
  • \$\begingroup\$ This sounds very big and very clever. Will have to look into it ^^ \$\endgroup\$ Commented 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\$ Commented 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\$ Commented 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\$ Commented Feb 4, 2016 at 12:32

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.