HiveBrain v1.2.0
Get Started
← Back to all entries
patternModerate

Importing data from an external EXCEL-Sheet

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
excelsheetexternalimportingfromdata

Problem

I was assigned the task of copying some subsums from a given EXCEL-Sheet into the executing EXCEL-Sheet.

This had to be done with an EXCEL-Macro, so non-programmers can easily use it. There was the need to compare the final sum of copied values to the sum of values in the given sheet, as it's about business critical finance.

What can be said about the readability and maintainability?

Enough talk, here's the code. I am inserting ` to divide the code into it's logical parts. That should make it more readable.

Sub TelekomRechnungEinlesen()
Dim lastSetTelekomRow As Long
Dim lastSetNovatecRow As Long

Dim iterator As Long
Dim novatecSumColumn As String

Dim mobilenumberSpalte As String
Dim subSumFlag As String
Dim bereichsSpalte As String
Dim bereichsWert As String
Dim telekomSumColumn As String

Dim mobilenumber As String
Dim NTmobilenumber As String

' used worksheet shortcuts
Dim TKSheet As Worksheet
Dim NTSheet As Worksheet

' final comparison required stuff
Dim novatecSum As Double
Dim telekomSum As Double
Dim closeflag As Boolean

mobilenumberSpalte = "D"
bereichsSpalte = "F"
novatecSumColumn = "E"
telekomSumColumn = "O"
bereichsWert = "Telekom Deutschland GmbH"


``
' Select Target worksheet
Workbooks(1).Worksheets(1).Activate
Set NTSheet = ActiveSheet

lastSetNovatecRow = LastRowInGivenSheet(NTSheet)

NTSheet.Range(novatecSumColumn & "2:" & novatecSumColumn & lastSetNovatecRow).Value = ""

' Open file dialog
FileToOpen = Application.GetOpenFilename _
(Title:="Bitte Telekomrechnung auswählen", _
FileFilter:="Excel Files .xls (.xls),")

If FileToOpen = False Then
MsgBox "Keine Datei ausgewählt", vbExclamation, "Fehler!"
Exit Sub
Else
Workbooks.Open Filename:=FileToOpen
End If

Workbooks(2).Worksheets(3).Activate
Set TKSheet = ActiveSheet

lastSetTelekomRow = LastRowInGivenSheet(TKSheet)

tCol = novatecSumColumn

' Start Data Transfer
For tkI = 2 To lastSetTelekomRow
iterator = 2

subSumFlag = TKSheet.Range(bereichsSpalte & tkI).

Solution

The indentation in TelekomRechnungEinlesen makes it hard to tell where it starts and where it ends. Sub and End Sub define a scope - anything in between should have a Tab:

Sub TelekomRechnungEinlesen()

    Dim lastSetTelekomRow As Long
    Dim lastSetNovatecRow As Long

    Dim iterator As Long
    Dim novatecSumColumn As String

    Dim mobilenumberSpalte As String
    Dim subSumFlag As String
    Dim bereichsSpalte As String
    Dim bereichsWert As String
    Dim telekomSumColumn As String

    Dim mobilenumber As String
    Dim NTmobilenumber As String

    ' used worksheet shortcuts
    Dim TKSheet As Worksheet
    Dim NTSheet As Worksheet

    ' final comparison required stuff
    Dim novatecSum As Double
    Dim telekomSum As Double
    Dim closeflag As Boolean


I used to do that too in VB6/VBA: declare all my variables at the top. I stopped doing that after seeing the benefits of declaring variables as close as possible to their usage. Sticking declarations at the top of a procedure is ok if your procedure is a 5-liner or similar. Clearly, that's not the case here. Let's see...

Dim mobilenumberSpalte As String
mobilenumberSpalte = "D"

Dim bereichsSpalte As String
bereichsSpalte = "F"

Dim novatecSumColumn As String
novatecSumColumn = "E"

Dim telekomSumColumn As String
telekomSumColumn = "O"

bereichsWert = "Telekom Deutschland GmbH"


These aren't really variables, they're more like constants. Declaring them as such clears a bunch of declarations and assignments from the function:

Private Const MobileNumberSpalte As String = "D"
Private Const BereichsSpalte As String = "F"
Private Const NovatecSumColumn As String = "E"
Private Const TelekomSumColumn As String = "O"


What the procedure actually does:

  • Activate the first sheet of the first opened workbook, keep a reference to the active sheet.



  • Get the last row with data on that sheet.



  • Clear values of [E2:Ex], where x is the last row with data.



Break here. Scratch LastRowInGivenSheet and take a look at this fabulous Stack Overflow answer:

Find Last Row in a Column


To find the last Row in Col E use this:

With Sheets("Sheet1")
    LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With




https://stackoverflow.com/questions/11169445

How about extracting functions out of that monster?

Private Function FindAndActivateFirstWorksheet() As Worksheet

    If Workbooks.Count = 0 Then Exit Function 'return Nothing

    Dim result As Worksheet
    Set result = Workbooks(1).Worksheets(1)

    result.Activate
    Set FindAndActivateFirstWorksheet = result

End Function

Private Function GetLastDataRow(xlSheet As Worksheet, Optional column As String = "A") As Long
    GetLastDataRow = xlSheet.Range(column & xlSheet.Rows.Count).End(xlUp).Row
End Function


Clearing the contents of a Range object is as easy as calling Range.ClearContents().

So, moving on:

  • Bring up a FileDialog, open any Excel file that the user selects.



  • Activate the 3rd sheet in the 2nd workbook (the one we just opened?) and keep a reference to the active sheet.



This should also be extracted in its own function that returns a Worksheet object, or Nothing if the user, say, cancelled out of the FileDialog. I believe your code... blows up if that happens, right? And what if the user opens a workbook that doesn't have the layout you're expecting, or if a user has inserted a worksheet and the one you're expecting 3rd is now 4th?

If possible, give the 3rd worksheet a specific name, and refer to that sheet by its name in code, and then gracefully handle the case where the expected sheet name isn't found in the selected workbook file; it's also likely that the workbooks that work with this macro are all called a certain specific way - you can validate that before opening the workbook file.

Activating the 1st sheet in the 1st book and returning it, is pretty much like activating the 3rd sheet in the 2nd book and returning it, no?

Private Function FindAndActivateWorksheet(xlWorkbook As Workbook, Optional ByVal sheetIndex As Long, Optional ByVal sheetName As String) As Worksheet

    Dim isIndex As Boolean
    isIndex = Not IsMissing(sheetIndex)
    If Not isIndex And IsMissing(sheetName) Then
        isIndex = True
        sheetIndex = 1
    End If 

    Dim result As Worksheet
    If isIndex Then
        Set result = xlWorkbook.Worksheets(sheetIndex)
    Else
        Set result = xlWorkbook.Worksheets(sheetName)
    End If

    result.Activate
    Set FindAndActivateWorksheet = result

End Function


Now you can use that to find and activate the Nth sheet of any workbook, or to find and activate a sheet with a specific name, in any workbook - just pass in the workbook instance and what you're looking for. If there's an error (most likely something like an index out of range error), it's up to the caller to handle it.

The procedure is doing a lot more. Isolate each thing it does, extract it into a

Code Snippets

Sub TelekomRechnungEinlesen()

    Dim lastSetTelekomRow As Long
    Dim lastSetNovatecRow As Long

    Dim iterator As Long
    Dim novatecSumColumn As String

    Dim mobilenumberSpalte As String
    Dim subSumFlag As String
    Dim bereichsSpalte As String
    Dim bereichsWert As String
    Dim telekomSumColumn As String

    Dim mobilenumber As String
    Dim NTmobilenumber As String

    ' used worksheet shortcuts
    Dim TKSheet As Worksheet
    Dim NTSheet As Worksheet

    ' final comparison required stuff
    Dim novatecSum As Double
    Dim telekomSum As Double
    Dim closeflag As Boolean
Dim mobilenumberSpalte As String
mobilenumberSpalte = "D"

Dim bereichsSpalte As String
bereichsSpalte = "F"

Dim novatecSumColumn As String
novatecSumColumn = "E"

Dim telekomSumColumn As String
telekomSumColumn = "O"

bereichsWert = "Telekom Deutschland GmbH"
Private Const MobileNumberSpalte As String = "D"
Private Const BereichsSpalte As String = "F"
Private Const NovatecSumColumn As String = "E"
Private Const TelekomSumColumn As String = "O"
With Sheets("Sheet1")
    LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With
Private Function FindAndActivateFirstWorksheet() As Worksheet

    If Workbooks.Count = 0 Then Exit Function 'return Nothing

    Dim result As Worksheet
    Set result = Workbooks(1).Worksheets(1)

    result.Activate
    Set FindAndActivateFirstWorksheet = result

End Function

Private Function GetLastDataRow(xlSheet As Worksheet, Optional column As String = "A") As Long
    GetLastDataRow = xlSheet.Range(column & xlSheet.Rows.Count).End(xlUp).Row
End Function

Context

StackExchange Code Review Q#43290, answer score: 13

Revisions (0)

No revisions yet.