Efficient VBA coding

hansgrandia

Board Regular
Joined
Jan 10, 2015
Messages
53
Hi,

After a couple of weeks going through trail and error to produce below standing (effective) code, I'm not satisfied with the efficiency in it and the fact that I'm not able to close an opened workbook (fNameAndPath) but instead I need to close all workbooks except the active workbook to make it work. I'm not sure, but this might has something to do with fNameandPath being a Variant...correct?

The specific questions:
- Could someone help me formulating a code that only closes fNameAndPath instead of all workbooks except active workbook at the end of the code? Current code is marked in red.
- Is there a better (more efficient) way to calculate the totals of the long list of "subcategories". Current code is marked in blue.
- I gues the code to copy a cell to another worksheet (specific cell) can be done more efficiently. One of the 20 examples is shown below in purple.

Sheets("Som Transacties").Cells(2, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(18, Month).Select 'ANWB
Selection.PasteSpecial

Appreciate your help. Regards,
Hans Grandia
Netherlands
....................................................................................................................

Sub GetFile()


Application.ScreenUpdating = False


Dim fNameAndPath As Variant
Dim ActiveWb As Workbook
Dim wb As Workbook
Dim Month As Long
Dim SumTotal As Double


Set ActiveWb = Application.ActiveWorkbook


ChDir "C:\Users\Hans\Documents\PRIVE\BOEKHOUDING\KASBOEKEN\DUMPS\2015"
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.XLS", Title:="Selecteer het te gebruiken bestand")
If fNameAndPath = False Then Exit Sub
Workbooks.Open (fNameAndPath)


Sheets("Som Transacties").Copy After:=ActiveWb.Sheets(ThisWorkbook.Sheets.Count)


Month = WorksheetFunction.CountA(Worksheets("Kostenbegroting").Range("A152:U152")) + 1

'Copy cells from "Som Transacties" to "Kostenbegroting"
Sheets("Som Transacties").Cells(2, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(18, Month).Select 'ANWB
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(3, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(25, Month).Select 'Auto verzekering
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(4, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(32, Month).Select 'Bankkosten
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(5, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(39, Month).Select 'Eten, drinken en persoonlijke verzorging
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(6, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(46, Month).Select 'Kleding
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(7, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select 'Kranten, weekbladen, KB
Cells(53, Month).Select
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(8, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(60, Month).Select 'Lasten woning
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(9, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(67, Month).Select 'Lidmaatschap kerk, goede doelen
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(10, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(74, Month).Select 'Onderhoud auto
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(11, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(81, Month).Select 'Opleiding en persoonlijke ontwikkeling
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(12, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(88, Month).Select 'Overig
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(13, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(95, Month).Select 'Reisverzekering
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(14, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(102, Month).Select 'Sport
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(15, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(109, Month).Select 'Uitvaartverzekering
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(16, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(116, Month).Select 'Vakantie en ontspanning
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(17, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(123, Month).Select 'Vakbond
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(18, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(130, Month).Select 'Vervoer
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(19, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(137, Month).Select 'Wegenbelasting
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(20, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(144, Month).Select 'Zakgeld / cadeaus / boetes
Selection.PasteSpecial

Sheets("Som Transacties").Activate
Sheets("Som Transacties").Cells(21, 2).Select
Selection.Copy
Sheets("Kostenbegroting").Select
Cells(151, Month).Select 'Ziektenkosten
Selection.PasteSpecial


'Calculate totals in worksheet "Kostenbegroting"
SumTotal = WorksheetFunction.Sum(Cells(18, Month), (Cells(25, Month)), (Cells(32, Month)), (Cells(39, Month)), (Cells(46, Month)), (Cells(53, Month)), _
(Cells(60, Month)), (Cells(67, Month)), (Cells(74, Month)), (Cells(81, Month)), (Cells(88, Month)), (Cells(95, Month)), (Cells(102, Month)), (Cells(109, Month)), _
(Cells(116, Month)), (Cells(123, Month)), (Cells(130, Month)), (Cells(137, Month)), (Cells(144, Month)), (Cells(151, Month)))
Cells(152, Month).Value = SumTotal


'Lay out
Range("H12").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveWindow.SmallScroll Down:=-993
Range("J12:U151").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("J151:U151").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With

'close workbooks except active workbook (should be: close fNameAndPath)
For Each wb In Workbooks
If Not (wb Is ActiveWorkbook) Then wb.Close
Next

Range("A1").Select
Application.ScreenUpdating = True


End Sub
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Activating worksheets and selecting content is much less efficient than working with ranges directly. For example, you could replace:
Code:
'Copy cells from "Som Transacties" to "Kostenbegroting" 
 Sheets("Som Transacties").Cells(2, 2).Select
 Selection.Copy
 Sheets("Kostenbegroting").Select
 Cells(18, Month).Select 'ANWB
 Selection.PasteSpecial
with:
Code:
'Copy cells from "Som Transacties" to "Kostenbegroting"
Sheets("Som Transacties").Cells(2, 2).Copy
Sheets("Kostenbegroting").Cells(18, Month).PasteSpecial 'ANWB
Depending on what you're trying to achieve, you might not even need to copy & paste, in which case, you might even more efficiently be able to use something like:
Code:
Sheets("Kostenbegroting").Cells(18, Month).Value = Sheets("Som Transacties").Cells(2, 2).Value
Although you could change:
Code:
SumTotal = WorksheetFunction.Sum(Cells(18, Month), (Cells(25, Month)), (Cells(32, Month)), (Cells(39, Month)), (Cells(46, Month)), (Cells(53, Month)), _
(Cells(60, Month)), (Cells(67, Month)), (Cells(74, Month)), (Cells(81, Month)), (Cells(88, Month)), (Cells(95, Month)), (Cells(102, Month)), (Cells(109, Month)), _
(Cells(116, Month)), (Cells(123, Month)), (Cells(130, Month)), (Cells(137, Month)), (Cells(144, Month)), (Cells(151, Month)))
Cells(152, Month).Value = SumTotal
to:
Code:
Cells(152, Month).Value = WorksheetFunction.Sum(Cells(18, Month), (Cells(25, Month)), (Cells(32, Month)), (Cells(39, Month)), (Cells(46, Month)), (Cells(53, Month)), _
(Cells(60, Month)), (Cells(67, Month)), (Cells(74, Month)), (Cells(81, Month)), (Cells(88, Month)), (Cells(95, Month)), (Cells(102, Month)), (Cells(109, Month)), _
(Cells(116, Month)), (Cells(123, Month)), (Cells(130, Month)), (Cells(137, Month)), (Cells(144, Month)), (Cells(151, Month)))
You'd get a negligible performance improvement by doing so.
 
Last edited:
Upvote 0
Your close can be (closes without changes)

Code:
Dim filname As String, xname As String
filname = Mid(fNameAndPath, InStrRev(fNameAndPath, "\", Len(fNameAndPath)) + 1, Len(fNameAndPath))
xname = Mid(filname, 1, InStr(filname, ".") - 1)
Workbooks(xname).Close False


All your copies can probably all be written just as...
Code:
Dim x As Long, y As Long
    x = 2
    y = 18

    Do Until x = 22
        Sheets("Kostenbegroting").Cells(y, Month).Value = Sheets("Som Transacties").Cells(x, 2).Value
       'Sheets("Som Transacties").Cells(x, 2).Copy Sheets("Kostenbegroting").Cells(y, Month) if you don't want values
        x = x + 1
        y = y + 7
    Loop
 
Last edited:
Upvote 0
Thank you guys for the great advice! What does it take to be reach your level of VBA skills?
Thanks again!
Hans
(Netherlands)
 
Upvote 0
You should use the variable wb as a reference to the workbook you are opening, then it's straighforward to close it once you've finished with it.
Code:
Set wb Workbooks.Open (fNameAndPath)

' other code

wb.Close SaveChanges:=False
 
Upvote 0

Forum statistics

Threads
1,213,559
Messages
6,114,302
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top