# Lots of different operations on workbooks in Excel

I have lots of workbooks on a given format. The workbooks explain a series of certain objects. I don't want to reveal exactly what this is, so I'll refer to it as just an "Item". I need to do the following:

Note: I have to open each files manually, since I need to check a comment in one of the cells manually.

• Read and store the last line of a merged cell (starting at A63)
• Update the following, if the cell A58 is empty:

• Mark that the Item is not close to road, unless it's already marked as being close to a road.

• Delete the content of O7, if Q3-Q5 are empty

• Update the title field. This is the same merged cell starting at A63 as before. The first line should be bold. The last line should be the same as the previous title (stored in the beginning).
• Enter some values
• Retrieve the name of the workbook, and insert the name in field O75
• Find east and north coordinates from the workbook "Coordinate_document.xlsx". The values are in sheet 2.
• I use a for loop to match the last line of the title, with the first column in the coordinate workbook.
• The coordinates are stored in the active workbook, on the formats given in the script.
• The workbook is saved in the end. It's not closed, since I need to do some manual checks too. I do want to save it, since I rarely change something after the macro finishes.

Sub updateCells()

Dim wbkSketchBook As Workbook
Dim wksSketchSheet As Worksheet

Set wbkSketchBook = ActiveWorkbook
Set wksSketchSheet = wbkSketchBook.ActiveSheet

' If the title starts with "L", then the number of characters that must be trimmed
' away on the left side is 49. Otherwise it's 40.
' I do this in the beginning, since I need sMast throughout the script.
Dim sTitle As String
Dim sMast As String
sTitle = wksSketchSheet.Range("A63").Value

' The first letter is stored, to be used while in debugging mode.
sFirstLetter = Left(sTitle, 1)
If sFirstLetter = "L" Then
sMast = Right(sTitle, Len(sTitle) - 49)
Else
sMast = Right(sTitle, Len(sTitle) - 40)
End If

' Don't run the following part of the script if there's already a value in cell AB58.
If IsEmpty(Range("AB58").Value) = True Then

' Place an X in cell AB53 (not close to road), only if cell X53 (close to road) and
' cell AB53 (explanation of why X53 is checked) are empty.
' If 'X53' is non-empty, and AB53 is empty, then display a message box saying this
' must be verified.
If IsEmpty(Range("X53").Value) = True Then
If IsEmpty(Range("X54").Value) = True Then
Range("AB53").Value = "X"
Else
MsgBox ("Close or not? Fix after macro is finished!")
End If
End If

' Check if there's a comment in U3. If not, then display a message box asking for
' verification that this is correct.
If IsEmpty(Range("U3").Value) = True Then
MsgBox ("No comment! Check after macro is finished!")
End If

' AI71, Executing should be "ABCD":
Range("AI71").Value = "ABCD"

' Check if all Q3-Q5 are empty. If so, delete the content of O7.
' O7 is only relevant if one of the
If IsEmpty(Range("Q3").Value) = True Then
If IsEmpty(Range("Q4").Value) = True Then
If IsEmpty(Range("Q5").Value) = True Then
Range("O7").Value = ""
End If
End If
End If

' Change the title. This is a merged cell, A63:AH67. The format is over three lines.
' The last line is the string sMast, while the others are fixed.
' The first line should be bold.
Range("A63:AH67").Select
ActiveCell.FormulaR1C1 =
'    "L1234.1 ABCD - Efghijklmn 123 oP" & Chr(10) & "Qrstuvwx sketch" & Chr(10) & sMast
With ActiveCell.Characters(Start:=1, Length:=33).Font
.Name = "Arial"
.FontStyle = "Halvfet"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
With ActiveCell.Characters(Start:=34, Length:=(Len(sTitle) - 22)).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With

' The classification must be updated (merged cell):
Range("A73:N73").Value = "Classification value"

' This should be "N/A" (merged cell).
Range("AB58:AF58").Value = "N/A"

' Update document number in O75. It should have the same name as the file,
' with .xlsx removed
Dim sDocumentNumber As String

' I can't use a fixed string, since I open many workbooks, and run the macro on each one.
' The macro is executed immediately after opening the workbook.
sDocumentNumber = ActiveWorkbook.Name
sDocumentNumber = Left(sDocumentNumber, Len(sDocumentNumber) - 5)
Range("O75").Value = sDocumentNumber

End If
' The previous part was only executed if there was no value in AB58.
' The following should be executed, regardless of what that cell contains.
' Coordinates:
Dim sNorth As String
Dim sEast As String

Dim sCoordinateBook As Worksheet
Set sCoordinateBook = Workbooks("Coordinate_document.xlsx").Worksheets(2)

Dim sMastenummer As String
sMastenummer = Right(sMast, Len(sMast) - 3)
Dim sValueEachIteration As String

Dim iterator As Long
Dim idx As Long
For iterator = 7 To 140
' The value each iteration is store, to be used while in debugging mode.
sValueEachIteration = sCoordinateBook.Cells(iterator, 1).Value

' If the value in that row in the Coorinate Book is equal to sMastenummer, then
' Then store the iterator.
If sValueEachIteration = sMastenummer Then
idx = iterator
End If
Next iterator

' Store the coordinates.
sNorth = sCoordinateBook.Cells(idx, 2).Value
sEast = sCoordinateBook.Cells(idx, 3).Value

' The ActiveSheet should still be the first workbook that was opened. The worksheet
' name should be "Drawing". If that's not the case, then something is wrong.
If ActiveSheet.Name = "Drawing" Then
Cells(54, 17).Value = sNorth
Cells(54, 17).NumberFormat = "0000000.000"
Cells(55, 17).Value = sEast
Cells(55, 17).NumberFormat = "000000.000"
ActiveWorkbook.Save
Else
MsgBox("The wrong workbook is active!")
End If

' The Workbook is saved if the coordinates are inserted properly. It is not closed,
' because I need to verify the values of some cells manually.
End Sub


So, any comments?

## 1 Answer

You have a lot of unqualified Range() calls in your code: your procedure would be more robust of you qualify all those calls with a worksheet object.

It's maybe just a preference, but I'd prefer to write this:

' The first letter is stored, to be used while in debugging mode.
sFirstLetter = Left(sTitle, 1)
If sFirstLetter = "L" Then
sMast = Right(sTitle, Len(sTitle) - 49)
Else
sMast = Right(sTitle, Len(sTitle) - 40)
End If


instead as this:

' The first letter is stored, to be used while in debugging mode.
sFirstLetter = Left(sTitle, 1)
sMast = Right(sTitle, Len(sTitle) - IIf(sFirstLetter = "L", 49, 40))


since you end up with less repeated code.

This code:

Range("A63:AH67").Select
ActiveCell.FormulaR1C1 = "..."


is better written as:

 Range("A63:AH67").Value = "..."


You almost never need to select/activate anything when working with VBA in Excel, and it's best to avoid relying on ActiveSheet/ActiveCell.

When formatting the font you can likely omit everything from .Strikethrough = False onwards, unless there are settings there which you're changing.

Exiting a loop if there are no more rows you need to check (and refactoring the code a little):

Dim rw As Range
For Each rw in sCoordinateBook.Range("A7:C140")
If rw.cells(1).value = sMastenummer Then
sNorth = rw.cells(2).Value
sEast = rw.cells(3).Value
Exit Sub
End If
Next rw

• I use Range(...).Value <> "" because I seem to remember having issues with 'IsEmpty(Range(...).Value). Have you had the same problem? – user109261 Sep 7 '17 at 17:15
• I typically use Len()>0 but this doesn't work well with error values (Type Mismatch, same problem with <>"") IsEmpty()` returns True for empty cells and those with errors. – Tim Williams Sep 7 '17 at 17:35