Importing data from an external EXCEL-Sheet

Question

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 <hr> 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).Value
    mobilenumber = TKSheet.Range(mobilenumberSpalte & tkI).Value

    While (iterator <= lastSetNovatecRow)

        NTmobilenumber = NTSheet.Range("C" & iterator).Value

        If mobilenumber = NTmobilenumber And subSumFlag = bereichsWert Then
            ' Copy the subtotal
            NTSheet.Range(tCol & iterator).Value = NTSheet.Range(tCol & iterator).Value + TKSheet.Range(telekomSumColumn & tkI).Value

            ' Copy some additional stuff
            NTSheet.Range("A" & iterator) = TKSheet.Range("C" & tkI).Value
            NTSheet.Range("B" & iterator) = TKSheet.Range("B" & tkI).Value

            ' mark as taken into account
            TKSheet.Range("A" & tkI & ":" & telekomSumColumn & tkI).Interior.Color = RGB(200, 200, 80)
        End If
    iterator = iterator + 1
    Wend
Next tkI

---

telekomSum = WorksheetFunction.SumIf(TKSheet.Range(bereichsSpalte & "2:" & bereichsSpalte & lastSetTelekomRow), _
          bereichsWert, TKSheet.Range(telekomSumColumn & "2:" & telekomSumColumn & lastSetTelekomRow))
novatecSum = WorksheetFunction.sum(NTSheet.Range(tCol & "2:" & tCol & lastSetNovatecRow))

closeflag = True

If Abs(telekomSum - novatecSum) >= 0.01 Then
    ' Error Message
    MsgBox "Summen stimmen nicht überein. " & _
    "Bitte überprüfen Sie die eingepflegten Verträge und Mobilfunknummern:" & vbCrLf & "NovaTec: " & _
    novatecSum & "€" & vbCrLf & "Telekom: " & gesamt & "€" & vbCrLf & vbCrLf & _
    "Doppelte Mobilfunknummern wurden in Ihrem Excel-Sheet markiert." & vbCrLf & _
    "Diese sind Hauptfehlerursache. Bitte beseitigen Sie eventuell doppelte Einträge" & _
    vbCrLf & vbCrLf & "Außerdem wurden in der Angegebenen Rechnung alle einbezogenen Subtotalen markiert" _
    , vbExclamation, "INFO:"

    ' Prevent closing of imported file
    closeflag = False

    ' Troubleshooting help for user
    NTSheet.Range("C2:C" & lastSetNovatecRow).Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlDuplicate
    Selection.FormatConditions(1).Interior.Color = RGB(255, 40, 80)
End If

If closeflag Then
    ' Close without saving
    Workbooks(2).Close (False)
End If

' Show compared values in the opened worksheet
NTSheet.Range(tCol & lastSetNovatecRow + 2).Value = novatecSum
NTSheet.Range("D" & lastSetNovatecRow + 2).Value = "NovaTec Summe"
NTSheet.Range(tCol & lastSetNovatecRow + 3).Value = telekomSum
NTSheet.Range("D" & lastSetNovatecRow + 3).Value = "Telekom Summe"
NTSheet.Range(tCol & lastSetNovatecRow + 4).Formula = "= " & tCol & lastSetNovatecRow + 2 & "-" & tCol & lastSetNovatecRow + 3
NTSheet.Range("D" & lastSetNovatecRow + 4).Value = "Differenz:"
End Sub

---

Function LastRowInGivenSheet(ByVal sheet As Worksheet) As Long
    Dim found As Boolean
    Dim LastRow As Long

    LastRow = 1
    found = False

    While Not found
        If sheet.Range("A" & (LastRow + 1)).Value = "" Then
            found = True
        Else
            LastRow = LastRow + 1
        End If
    Wend

    LastRowInGivenSheet = LastRow
End Function

I apologize for the variable naming... I decided to make the "configurable" variables German, as they should be maintainable by non-english speakers, in case the conditions and columns change ...

Answer 1

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 procedure or function; when you're done, it will read like plain English... or German. And you'll have a bunch of tiny little functions that do pretty much one single thing, with a "master" procedure at a high abstraction level, that anyone that can read could grasp and understand what it's doing, at a glance.