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?