Run my master workbook and call another non-macro enabled workbook and do the edits to it prior to saving

[Nlhicks]

I am getting an error on the line RngRang01 = Range("A" & Rows.Count).End(xlUp).Row and then when I move it into a with block I get an error on the line Sheet1.Range("B2:B" & RngRange01).Font.Color = vbRed. I had this code running on the workbook that it lives in and it worked marvelously now my supervisor asked that I make it a stand alone macro workbook that I can use to change the saved/shared file. I am not sure what I need to do at this point to make it work. I was able to get some of the others to work but this one is causing issues.



Sub LineUpdate1()
'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.
Application.ScreenUpdating = False

Dim RngRange01 As Range
Dim Wb As Workbook
Dim LineUpdate As Worksheet, Sheet2 As Worksheet
Dim Ws As Range
Dim Rowz As Integer


Windows("WAPA-UGPR Facility Rating and SOL Record (Master).xlsm").Activate
Sheets("Line Update").Activate
Set LineUpdate = Sheets("Line Update")

'Workbooks.Open Filename:="WAPA-UGPR Facility Rating and SOL Record (Test Workbook).xlsm"
Windows("WAPA-UGPR Facility Rating and SOL Record (Test Workbook).xlsm").Activate
Sheets("Facility Ratings & SOLs (Lines)").Activate

Set Sheet1 = Sheets("Facility Ratings & SOLs (Lines)")
Set Ws = Sheet1.UsedRange
With LineUpdate
'RngRang01 = Range("A" & Rows.Count).End(xlUp).Row
With Sheet1.Range("A1")
LineUpdate.Range("J13").Value = Sheet1.Range("A2:A685").SpecialCells(xlCellTypeVisible)

If LineUpdate.Range("C11") <> LineUpdate.Range("F11") And LineUpdate.Range("F11") <> "" Then
Sheet1.Range("B2:B" & RngRange01).Font.Color = vbRed
Sheet1.Range("B2:B" & RngRange01).Value = LineUpdate.Range("F11").Value
Else
If LineUpdate.Range("F11") = "" Then
Sheet1.Range("B2:B" & RngRange01).Value = Sheet1.Range("B2:B" & RngRange01).Value
End If
End If

If LineUpdate.Range("C12") <> LineUpdate.Range("F12") And LineUpdate.Range("F12") <> "" Then
Sheet1.Range("C2:C" & RngRange01).Font.Color = vbRed
Sheet1.Range("C2:C" & RngRange01).Value = LineUpdate.Range("F12").Value
Else

If LineUpdate.Range("F12") = "" Then
Sheet1.Range("C2:C" & RngRange01).Value = Sheet1.Range("C2:C" & RngRange01).Value

End If
End If


If LineUpdate.Range("C13") <> LineUpdate.Range("F13") And LineUpdate.Range("F13") <> "" Then
Sheet1.Range("D2:D" & RngRange01).Font.Color = vbRed
Sheet1.Range("D2:D" & RngRange01).Value = LineUpdate.Range("F13").Value
Else
If Worksheets("Line Update").Range("F13") = "" Then
Sheet1.Range("D2:D" & RngRange01).Value = Sheet1.Range("D2:D" & RngRange01).Value
End If
End If


If LineUpdate.Range("C14") <> LineUpdate.Range("F14") And LineUpdate.Range("F14") <> "" Then
Sheet1.Range("E2:E" & RngRange01).Font.Color = vbRed
Sheet1.Range("E2:E" & RngRange01).Value = Worksheets("Line Update").Range("F14").Value
Else
If LineUpdate.Range("F14") = "" Then
Sheet1.Range("E2:E" & RngRange01).Value = Sheet1.Range("E2:E").Value

End If
End If

If LineUpdate.Range("C15") <> LineUpdate.Range("F15") And LineUpdate.Range("F15") <> "" Then
Sheet1.Range("F2:F").Font.Color = vbRed
Sheet1.Range("F2:F" & RngRang01).Value = LineUpdate.Range("F15").Value
Else
If LineUpdate.Range("F15") = "" Then
Sheet1.Range("F2:F" & RngRang01).Value = Sheet1.Range("F2:F" & RngRang01).Value
End If
End If

If LineUpdate.Range("C16") <> LineUpdate.Range("F16") And LineUpdate.Range("F16") <> "" Then
Sheet1.Range("G2:G" & RngRang01).Font.Color = vbRed
Sheet1.Range("G2:G" & RngRang01).Value = WLineUpdate.Range("F16").Value
Else
If LineUpdate.Range("F16") = "" Then
Sheet1.Range("G2:G" & RngRang01).Value = Sheet1.Range("G2:G" & RngRang01).Value
End If
End If

If LineUpdate.Range("C17") <> LineUpdate.Range("F17") And LineUpdate.Range("F17") <> "" Then
Sheet1.Range("H2:H" & RngRang01).Font.Color = vbRed
Sheet1.Range("H2:H" & RngRang01).Value = LineUpdate.Range("F17").Value
Else
If LineUpdate.Range("F17") = "" Then
Sheet1.Range("H2:H" & RngRang01).Value = Sheet1.Range("H2:H" & RngRang01).Value
End If
End If

If LineUpdate.Range("C18") <> LineUpdate.Range("F18") And LineUpdate.Range("F18") <> "" Then
Sheet1.Range("I2:I" & RngRang01).Font.Color = vbRed
Sheet1.Range("I2:I" & RngRang01).Value = LineUpdate.Range("F18").Value
Else
If LineUpdate.Range("F18") = "" Then
Sheet1.Range("I2:I" & RngRang01).Value = Sheet1.Range("I2:I" & RngRang01).Value
End If
End If

'Worksheets("Line Update").Activate
End With
End With

Call LineColorCells

Call DoLineMath1
Application.ScreenUpdating = True

End Sub

 

[Nlhicks]

I tried doing (lngLastRow-(1-9), lngColumn(-1-9) in every combination to no avail

 

[Nlhicks]

The Red Bold section of code is Getting the Run-time error 1004 message Application-defined or object-defined error.

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
Debug.Print Rows.Count

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

End Sub

 

[Nlhicks]

Run-time error 1004 message Application-defined or object-defined error

 

[Nlhicks]

WAPA-UGPR Facility Rating and SOL Record (Master).xlsm
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1
2
3		From Substation:	Armour
4		Transformer ID:	KY1A
5
6			Current Rating	Changes		Updated
7
8		PRIMARY / SECONDARY Summer Normal	45	45							Delta Value
9		Limiting Element		#REF!											Summer			Winter
10		PRIMARY / SECONDARY Summer Emergency	50	50	0						Substation	Xfmr ID			Normal	Emergency		Normal	Emergency
11		Limiting Element		#REF!							Armour	AR KY1A	Primary/Secondary	Uprate	3.3	-2.1	Uprate	3.3	-2.1
12		TERTIARY Summer Normal	41.7	45	3.3								Tertiary	Uprate	3.3	-2.1	Uprate	3.3	-2.1
13		Limiting Element	45	#REF!									Primary/Secondary	Downrate			Downrate
14		TERTIARY Summer Emergency	52.1	50									Tertiary	Downrate			Downrate
15		Limiting Element		#REF!									Primary/Secondary	Downrate			Downrate
16		PRIMARY / SECONDARY Winter Normal	41.7	45									Tertiary	Downrate			Downrate
17		Limiting Element		#REF!									Primary/Secondary	Downrate			Downrate
18		PRIMARY / SECONDARY Winter Emergency	52.1	50									Tertiary	Downrate			Downrate
19		Limiting Element		#REF!
20		PRIMARY / SECONDARY Winter Emergency	41.7	45
21		Limiting Element	45	#REF!
22		TERTIARY Winter Normal	52.1	50
23		Limiting Element		#REF!
24
25
26
27
28
29
30			●
31		Summary of Updates:
32		● Armour+AR KY1A
33
34		(Primary/Secondary : -2.1 3.3 MVA, 3.3 -2.1 MVA)
35		(Tertiary : Uprate 3.3 MVA, -2.1 3.3 MVA)
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Xfmr Update

Cell Formulas
Range	Formula
E9	E9	=INDEX(#REF!,SMALL(IF(ISNUMBER((SEARCH('Xfmr Update'!B3,#REF!))*(SEARCH('Xfmr Update'!B4,#REF!))),MATCH(ROW(#REF!),ROW(#REF!)),""),ROWS(#REF!)),COLUMNS(#REF!))
F10,F12	F10	=E10-D10
E11	E11	=INDEX(#REF!,SMALL(IF(ISNUMBER((SEARCH('Xfmr Update'!B3,#REF!))*(SEARCH('Xfmr Update'!B4,#REF!))),MATCH(ROW(#REF!),ROW(#REF!)),""),ROWS(#REF!)),COLUMNS(#REF!))
E13	E13	=INDEX(#REF!,SMALL(IF(ISNUMBER((SEARCH('Xfmr Update'!B3,#REF!))*(SEARCH('Xfmr Update'!B4,#REF!))),MATCH(ROW(#REF!),ROW(#REF!)),""),ROWS(#REF!)),COLUMNS(#REF!))
E15	E15	=INDEX(#REF!,SMALL(IF(ISNUMBER((SEARCH('Xfmr Update'!B3,#REF!))*(SEARCH('Xfmr Update'!B4,#REF!))),MATCH(ROW(#REF!),ROW(#REF!)),""),ROWS(#REF!)),COLUMNS(#REF!))
E17	E17	=INDEX(#REF!,SMALL(IF(ISNUMBER((SEARCH('Xfmr Update'!B3,#REF!))*(SEARCH('Xfmr Update'!B4,#REF!))),MATCH(ROW(#REF!),ROW(#REF!)),""),ROWS(#REF!)),COLUMNS(#REF!))
O11:O18,R11:R18	O11	=IF(P11>0,"Uprate","Downrate")
E19	E19	=INDEX(#REF!,SMALL(IF(ISNUMBER((SEARCH('Xfmr Update'!B3,#REF!))*(SEARCH('Xfmr Update'!B4,#REF!))),MATCH(ROW(#REF!),ROW(#REF!)),""),ROWS(#REF!)),COLUMNS(#REF!))
E21	E21	=INDEX(#REF!,SMALL(IF(ISNUMBER((SEARCH('Xfmr Update'!B3,#REF!))*(SEARCH('Xfmr Update'!B4,#REF!))),MATCH(ROW(#REF!),ROW(#REF!)),""),ROWS(#REF!)),COLUMNS(#REF!))
C8	C8	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$C$1
C9	C9	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$D$1
C10	C10	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$E$1
C11	C11	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$F$1
C12	C12	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$G$1
C13	C13	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$H$1
C14	C14	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$I$1
C15	C15	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$J$1
C16	C16	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$K$1
C17,C19	C17	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$L$1
C18,C20	C18	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$M$1
C21	C21	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$N$1
C22	C22	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$O$1
C23	C23	='C:\Users\nhicks\Documents\Ratings\Saved Versions\[WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm]Facility Ratings & SOLs (Xfmrs)'!$P$1
E23	E23	=INDEX(#REF!,SMALL(IF(ISNUMBER((SEARCH('Xfmr Update'!B3,#REF!))*(SEARCH('Xfmr Update'!B4,#REF!))),MATCH(ROW(#REF!),ROW(#REF!)),""),ROWS(#REF!)),COLUMNS(#REF!))
C32	C32	=CONCAT(D30," ",L11, "+",M11)

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C32:J41	Expression	=OR(C32="",C32="____")	text	NO
S11:T18	Expression	=OR(S11="",S11="____")	text	NO
P11:Q18	Expression	=OR(P11="",P11="____")	text	NO
L11:M18	Expression	=OR(L11="",L11="____")	text	NO
D8:D23	Expression	=OR(D8="",D8="____")	text	NO
D4	Expression	=OR(D4="",D4="____")	text	NO
D3	Expression	=OR(D3="",D3="____")	text	NO

 

[Nlhicks]

WAPA-UGPR Facility Rating and SOL Record (Data File)_v163.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	FROM Substation Name	Transformer ID	PRIMARY / SECONDARY Summer Normal	Limiting Element	PRIMARY / SECONDARY Summer Emergency	Limiting Element	TERTIARY Summer Normal	Limiting Element	TERTIARY Summer Emergency	Limiting Element	PRIMARY / SECONDARY Winter Normal	Limiting Element	PRIMARY / SECONDARY Winter Emergency	Limiting Element	TERTIARY Winter Normal	Limiting Element	TERTIARY Winter Emergency	Limiting Element
3	Armour	AR KY1A	45	#REF!	50		41.7		52.1		41.7		52.1		41.7		52.1
Facility Ratings & SOLs (Xfmrs)

 

[Nlhicks]

I am not sure how to get the code pasted in here via XL2BB but here is how it has adapted recently, and I am still getting errors:

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 Double
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\Owner\Documents\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
' lngLastRow = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1).Row
' wksFrom.Range("L11").Value = .Range("A2:A150").SpecialCells(xlCellTypeVisible).Cells.Value
' For lngLooper = 8 To 23
' With .Cells(lngLastRow, lngLooper - 9)
' If wksFrom.Cells(lngLooper, "D") <> wksFrom.Cells(lngLooper, "E") And wksFrom.Cells(lngLooper, "E") <> "" Then
' .Font.Color = vbRed
' With .Range("A" & lngLastRow & ":N" & lngLastRow).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
' Next lngLooper
' End With
With wksWorkOn
lngLastRow = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1).Row
wksFrom.Range("L11").Value = .Range("A2:A186").SpecialCells(xlCellTypeVisible).Cells.Value
wksFrom.Range("M11").Value = .Range("B2:B186").SpecialCells(xlCellTypeVisible).Cells.Value
lngColumn = 3 'representing column number 3 (C), will get augmented before the next row number
For lngLooper = 8 To 23
Debug.Print Rows.Count
With .Cells(lngLastRow, lngLooper - 6)
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
' Next lngColumn
End With

Call DoXfmrMath1 'commented out for test

end_here:
Workbook_Worksheet2Nothing wbkTarget, wksWorkOn
Workbook_Worksheet2Nothing wbkData, wksFrom
If blnEnd Then End

End Sub
Sub GetWorkbook_Worksheet(sPath As String, _
sWbName As String, _
wbkToSet As Object, _
sShName As String, _
wksToSet As Object)

'Parameters passed:
' sPath: Drive and Path to the Folder for workbook
' sWbName: Name and Extension of workbook
' wbkToSet: Empty Object to the workbook which should be filled withing
' sShName: Name of worksheet in workbook
' wksToSet: Empty Object to the worksheet which should be filled withing

Dim wb As Workbook 'object to loop through the open workbooks in the instance
Dim blnNew As Boolean 'to detect whether workbook is opend (active one by default then) or
'was open (so must not be active one) deciding how to check for the sheetname

blnNew = False

If Len(sWbName) = 0 Then GoTo end_GetWbkWks
For Each wb In Workbooks
If LCase(wb.Name) = LCase(sWbName) Then
Set wbkToSet = wb
Exit For
End If
Next wb

If wbkToSet Is Nothing Then
If Right(sPath, 1) <> Application.PathSeparator Then sPath = sPath & Application.PathSeparator
If Dir(sPath, vbDirectory) = "" Then GoTo end_GetWbkWks
If Dir(sPath & sWbName) <> "" Then
Set wbkToSet = Workbooks.Open(sPath & sWbName)
blnNew = True
Else
GoTo end_GetWbkWks
End If
End If

If Len(sShName) = 0 Then GoTo end_GetWbkWks
If blnNew Then
If Evaluate("ISREF('" & sShName & "'!A1)") Then
Set wksToSet = wbkToSet.Sheets(sShName)
End If
Else
If Evaluate("ISREF('[" & sWbName & "]" & sShName & "'!A1)") Then
Set wksToSet = wbkToSet.Sheets(sShName)
End If
End If
end_GetWbkWks:

End Sub

Sub Workbook_Worksheet2Nothing(wbkToSet As Object, wksToSet As Object)

Set wksToSet = Nothing
Set wbkToSet = Nothing

End Sub
Function HighestVersion(FolderName As String, _
Ext As String, _
StartFileName As String) As String
' Run my master workbook and call another non-macro enabled workbook and do the edits to it prior to saving
' adapted from: Find the latest version

Dim lngCompare As Long
Dim lngVersion As Long
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim NewFileName As String
Dim strVers As String

If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
If Dir(FolderName, vbDirectory) = "" Then
MsgBox "Problems for path" & FolderName, vbInformation, "Ending here"
End
End If
Set objFSO = CreateObject("scripting.filesystemobject")
Set objFolder = objFSO.GetFolder(FolderName)
For Each objFile In objFolder.Files
If UCase(Left(objFile.Name, Len(StartFileName))) = UCase(StartFileName) Then
lngCompare = 0
strVers = Trim(Mid(objFile.Name, Len(StartFileName) + 1))
If InStr(1, strVers, ".") > 0 Then lngCompare = CLng(Left(strVers, InStr(1, strVers, ".") - 1))
If lngCompare > lngVersion Then
lngVersion = lngCompare
NewFileName = objFile.Name
End If
End If
Next objFile
HighestVersion = NewFileName
Set objFolder = Nothing
Set objFSO = Nothing
End Function

Sub DoXfmrMath1()

Dim i As Integer
Dim wb As Workbook
Dim wbFacility As Workbook
Dim Update As Worksheet


Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
Const cstrUpdate As String = "Xfmr Update"

For Each wb In Workbooks
If LCase(wb.Name) = LCase(cstrWbFacility) Then
Set wbFacility = wb
Exit For
End If
Next wb
If wbFacility Is Nothing Then
If Dir(cstrWbFacility) <> "" Then
Set wbFacility = Workbooks.Open(cstrWbFacility)
Else
MsgBox "Could not find '" & cstrWbFacility & "' in current folder. Please open workbook and start again.", vbInformation, "Ending here"
GoTo end_here
End If
End If
If Evaluate("ISREF('[" & cstrWbFacility & "]" & cstrUpdate & "'!A1)") Then
Set Update = wbFacility.Sheets(cstrUpdate)
Else
MsgBox "Sheet '" & cstrUpdate & "' not found in workbook '" & cstrWbFacility, vbInformation, "Ending here"
GoTo end_here
End If
With Update
For i = 0 To 1
If .Cells(8 + (i * 4), "D").Value <> .Cells(8 + (i * 4), "E").Value Then
.Cells(11 + i, "P").Value = .Cells(8 + (i * 4), "E") - .Cells(8 + (i * 4), "D")
On Error GoTo DoubleRating
End If

If .Cells(10 + (i * 4), "D").Value <> .Cells(10 + (i * 4), "E").Value Then
.Cells(11 + i, "Q").Value = .Cells(10 + (i * 4), "E") - .Cells(10 + (i * 4), "D")
End If

If .Cells(16 + (i * 4), "D").Value <> .Cells(16 + (i * 4), "E").Value Then
.Cells(11 + i, "S").Value = .Cells(16 + (i * 4), "E") - .Cells(16 + (i * 4), "D")
End If
If .Cells(18 + (i * 4), "D").Value <> .Cells(18 + (i * 4), "E").Value Then
.Cells(11 + i, "T").Value = .Cells(18 + (i * 4), "E") - .Cells(18 + (i * 4), "D")
End If
Next i
' End If
End With



end_here:
Set wsUpdate = Nothing
Set wbFacility = Nothing

DoubleRating:
'
MsgBox "Please do these caluclations by hand, they differ from all of the rest and this code will not calculate them for you, sorry"
GoTo EndSub

EndSub:

Call Xfmr_Bold_in_Concatenate1
End Sub
'Sub DoXfmrMath1()
' Dim wsUpdate As Worksheet
' Dim i As Long
' Dim wb As Workbook
' Dim wbFacility As Workbook
' Dim cstrUpdate
' 'Dim wsUpdate As Worksheet
'
' Const cstrPath As String = "C:\Users\nhicks\Documents\Ratings\Saved Versions\"
' Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
' Const cstrwsUpdate As String = "Xfmr Update"
'
' For Each wb In Workbooks
' If LCase(wb.Name) = LCase(cstrWbFacility) Then
' Set wbFacility = wb
' Exit For
' End If
' Next wb
'
' If wbFacility Is Nothing Then
' If Dir(cstrWbFacility) <> "" Then
' Set wbFacility = Workbooks.Open(cstrWbFacility)
' Else
' MsgBox "Could not find '" & cstrWbFacility & "' in current folder. Please open workbook and start again.", vbInformation, "Ending here"
' GoTo end_here
' End If
' End If
'
' If Evaluate("ISREF('[" & cstrWbFacility & "]" & cstrwsUpdate & "'!A1)") Then
' Set wsUpdate = wbFacility.Sheets(cstrwsUpdate)
' Else
' MsgBox "Sheet '" & cstrUpdate & "' not found in workbook '" & cstrWbFacility, vbInformation, "Ending here"
' GoTo end_here
' End If
'
' With wsUpdate
' For i = 0 To 1
' If .Cells(8 + (i * 4), "D").Value <> .Cells(8 + (i * 4), "E").Value Then
' On Error GoTo displaymsg
' .Cells(11 + i, "P").Value = .Cells(8 + (i * 4), "E") - .Cells(8 + (i * 4), "D")
' On Error GoTo 0
' End If
'
' If .Cells(10 + (i * 4), "D").Value <> .Cells(10 + (i * 4), "E").Value Then
' .Cells(11 + i, "Q").Value = .Cells(10 + (i * 4), "E") - .Cells(10 + (i * 4), "D")
' End If
'
' If .Cells(16 + (i * 4), "D").Value <> .Cells(16 + (i * 4), "E").Value Then
' .Cells(11 + i, "S").Value = .Cells(16 + (i * 4), "E") - .Cells(16 + (i * 4), "D")
' End If
'
' If .Cells(18 + (i * 4), "D").Value <> .Cells(18 + (i * 4), "E").Value Then
' .Cells(11 + i, "T").Value = .Cells(18 + (i * 4), "E") - .Cells(18 + (i * 4), "D")
' End If
' Next i
' ' End If
' End With
'
' Call Xfmr_Bold_in_Concatenate1
'
'end_here:
' Set wsUpdate = Nothing
'
'displaymsg:
'MsgBox "Check cells E" & 8 + (i * 4) & " and D" & 8 + (i * 4)

'End Sub
Public Sub Xfmr_Bold_in_Concatenate1()

Dim EN As String, JN As String, GN As String, FN As String, HN As String, KN As String, LN As String, MN As String, NN As String, PN As String, EM As String, FM As String, _
GM As String, HM As String, KM As String

EN = Worksheets("Xfmr Update").Range("N11")
FN = Worksheets("Xfmr Update").Range("P11")
GN = Worksheets("Xfmr Update").Range("O9")
HN = Worksheets("Xfmr Update").Range("R9")
JN = Worksheets("Xfmr Update").Range("Q11")
KN = Worksheets("Xfmr Update").Range("N12")
LN = Worksheets("Xfmr Update").Range("S11")
MN = Worksheets("Xfmr Update").Range("T11")

EM = Worksheets("Xfmr Update").Range("O12")
FM = Worksheets("Xfmr Update").Range("N12")
GM = Worksheets("Xfmr Update").Range("P12")
HM = Worksheets("Xfmr Update").Range("Q12")
KM = Worksheets("Xfmr Update").Range("S12")

Range("C34").Value = ("(" & EN & " : " & " " & GN & " " & JN & " " & LN & " " & "MVA" & "," & " " & HN & " " & FN & " " & MN & " " & "MVA" & ")")
Range("C34").Font.Bold = True
Range("C35").Value = ("(" & FM & " : " & " " & GN & " " & EM & " " & GM & " " & "MVA" & "," & " " & HN & " " & " " & HM & " " & KM & " " & "MVA" & ")")
Range("C35").Font.Bold = True

End Sub