Nlhicks
Active Member
- Joined
- Jan 8, 2021
- Messages
- 264
- Office Version
- 365
- Platform
- Windows
The Large Font Section is what the debugger is saying is causing the error. I tried subtracting from each variable but it did not help. Any suggestions?
Const cstrMsgTitle As String = "Ending XfmrUpdate"
'
Sub XfmrUpdate1()
' Run my master workbook and call another non-macro enabled workbook and do the edits to it prior to saving
'Last update 11/16/2022 by NLH
'Line Update Task List
'Compares what the user enters as Changes to what is in the existing spreadsheet.
'If there is a difference: The font color changes to red and the number is updated to match the user input. Otherwise if there is no change it keeps the original formatting and information.
'It then does the math to compute the difference between what was and what is now and defines it as uprate/downrate in a table to the right.
'Then it concatenates all of the values together to paste into an email and that is in a table down below.
'This module and the next 4 (Module 3,4,5,6,7) are all pretty much the same but each one is for a new change if more than one are made.
' Updated: 20221205
'
Dim blnEnd As Boolean
Dim lngLastRow As Long
Dim lngLooper As Long
Dim lngColumn As Long
Dim strWbVersion As String
Dim wbkData As Workbook
Dim wksFrom As Worksheet
Dim wbkTarget As Workbook
Dim wksWorkOn As Worksheet
Const cstrPath As String = "C:\Users\nhicks\Documents\Ratings\Saved Versions\"
Const cstrWbData As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
Const cstrShData As String = "Xfmr Update"
Const cstrStFileName As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"
Const cstrShFacility As String = "Facility Ratings & SOLs (Xfmrs)"
GetWorkbook_Worksheet cstrPath, cstrWbData, wbkData, cstrShData, wksFrom
If wbkData Is Nothing Then
MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
blnEnd = True
GoTo end_here
End If
If wksFrom Is Nothing Then
MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
blnEnd = True
GoTo end_here
End If
'/// will find any xls, xlsb, xlsx or xlsm workbook that start with cstrStFileName
'/// and should deliver the highest number from there
strWbVersion = HighestVersion(cstrPath, ".xlsm", cstrStFileName)
If Len(strWbVersion) = 0 Then
MsgBox "Could not spot a version of " & vbCrLf & cstrStFileName & _
vbCrLf & "in Path " & cstrPath, vbInformation, cstrMsgTitle
blnEnd = True
GoTo end_here
End If
GetWorkbook_Worksheet cstrPath, strWbVersion, wbkTarget, cstrShFacility, wksWorkOn
If wbkTarget Is Nothing Then
MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
blnEnd = True
GoTo end_here
End If
If wksWorkOn Is Nothing Then
MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
blnEnd = True
GoTo end_here
End If
With wksWorkOn
lngColumn = 3 'representing column number 3 (C), will get augmented before the next row number
For lngLooper = 8 To 23
With .Cells(lngLastRow, lngColumn)
If wksFrom.Cells(lngLooper, "D") <> wksFrom.Cells(lngLooper, "E") And wksFrom.Cells(lngLooper, "E") <> "" Then
.Font.Color = vbRed
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ColorIndex = 34
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Value = wksFrom.Cells(lngLooper, "E").Value
Else
If wksFrom.Cells(lngLooper, "E") = "" Then
.Value = .Value
End If
End If
End With
lngColumn = lngColumn + 1
Next lngLooper
End With
Call DoXfmrMath1 'commented out for test
end_here:
Workbook_Worksheet2Nothing wbkTarget, wksWorkOn
Workbook_Worksheet2Nothing wbkData, wksFrom
If blnEnd Then End
Const cstrMsgTitle As String = "Ending XfmrUpdate"
'
Sub XfmrUpdate1()
' Run my master workbook and call another non-macro enabled workbook and do the edits to it prior to saving
'Last update 11/16/2022 by NLH
'Line Update Task List
'Compares what the user enters as Changes to what is in the existing spreadsheet.
'If there is a difference: The font color changes to red and the number is updated to match the user input. Otherwise if there is no change it keeps the original formatting and information.
'It then does the math to compute the difference between what was and what is now and defines it as uprate/downrate in a table to the right.
'Then it concatenates all of the values together to paste into an email and that is in a table down below.
'This module and the next 4 (Module 3,4,5,6,7) are all pretty much the same but each one is for a new change if more than one are made.
' Updated: 20221205
'
Dim blnEnd As Boolean
Dim lngLastRow As Long
Dim lngLooper As Long
Dim lngColumn As Long
Dim strWbVersion As String
Dim wbkData As Workbook
Dim wksFrom As Worksheet
Dim wbkTarget As Workbook
Dim wksWorkOn As Worksheet
Const cstrPath As String = "C:\Users\nhicks\Documents\Ratings\Saved Versions\"
Const cstrWbData As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
Const cstrShData As String = "Xfmr Update"
Const cstrStFileName As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"
Const cstrShFacility As String = "Facility Ratings & SOLs (Xfmrs)"
GetWorkbook_Worksheet cstrPath, cstrWbData, wbkData, cstrShData, wksFrom
If wbkData Is Nothing Then
MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
blnEnd = True
GoTo end_here
End If
If wksFrom Is Nothing Then
MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
blnEnd = True
GoTo end_here
End If
'/// will find any xls, xlsb, xlsx or xlsm workbook that start with cstrStFileName
'/// and should deliver the highest number from there
strWbVersion = HighestVersion(cstrPath, ".xlsm", cstrStFileName)
If Len(strWbVersion) = 0 Then
MsgBox "Could not spot a version of " & vbCrLf & cstrStFileName & _
vbCrLf & "in Path " & cstrPath, vbInformation, cstrMsgTitle
blnEnd = True
GoTo end_here
End If
GetWorkbook_Worksheet cstrPath, strWbVersion, wbkTarget, cstrShFacility, wksWorkOn
If wbkTarget Is Nothing Then
MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
blnEnd = True
GoTo end_here
End If
If wksWorkOn Is Nothing Then
MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
blnEnd = True
GoTo end_here
End If
With wksWorkOn
lngColumn = 3 'representing column number 3 (C), will get augmented before the next row number
For lngLooper = 8 To 23
With .Cells(lngLastRow, lngColumn)
If wksFrom.Cells(lngLooper, "D") <> wksFrom.Cells(lngLooper, "E") And wksFrom.Cells(lngLooper, "E") <> "" Then
.Font.Color = vbRed
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ColorIndex = 34
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Value = wksFrom.Cells(lngLooper, "E").Value
Else
If wksFrom.Cells(lngLooper, "E") = "" Then
.Value = .Value
End If
End If
End With
lngColumn = lngColumn + 1
Next lngLooper
End With
Call DoXfmrMath1 'commented out for test
end_here:
Workbook_Worksheet2Nothing wbkTarget, wksWorkOn
Workbook_Worksheet2Nothing wbkData, wksFrom
If blnEnd Then End