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

 

[HaHoBe]

Hi Nlhicks,

please use [ CODE ] before and [ /CODE ] after (without blanks) for displaying codes here.

Your code looks like this:

For Each wb In Workbooks
If LCase(wb.Name) = LCase(cstrWbFacility) Then
Set wbFacility = wb
Exit For
End If
Next wb

Using code tags code looks like this

  For Each wb In Workbooks
    If LCase(wb.Name) = LCase(cstrWbFacility) Then
      Set wbFacility = wb
      Exit For
    End If
  Next wb

Please test the following modification:

Sub MrE_1223414_LineUpdate_mod02()
' https://www.mrexcel.com/board/threads/run-my-master-workbook-and-call-another-non-macro-enabled-workbook-and-do-the-edits-to-it-prior-to-saving.1223414/
'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.

  Dim lngLastRow As Long
  Dim wbFacility As Workbook
  Dim wsUpdate As Worksheet
  Dim wsFacility As Worksheet
  Dim lngLooper As Long
  Dim wb As Workbook
  Dim strWbVersion As String
  
  '//// adjust the path to match, this is my sample for testing \\\'
  Const cstrPath As String = "C:\Users\nhicks\Documents\Ratings\Saved Versions\"
  
  Const cstrStFileName As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"
  Const cstrUpdate As String = "Line Update"
  
  Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
  Const cstrShFacility As String = "Facility Ratings & SOLs (Lines)"

  Application.ScreenUpdating = False
  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
  '///changed for workbook and worksheet
  If Evaluate("ISREF('[" & cstrWbFacility & "]" & cstrUpdate & "'!A1)") Then
    Set wsUpdate = wbFacility.Sheets(cstrUpdate)
  Else
    MsgBox "Sheet '" & cstrUpdate & "' not found in workbook '" & cstrWbFacility, vbInformation, "Ending here"
    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, ".xls", cstrStFileName)
  If Len(strWbVersion) = 0 Then
    MsgBox "Could not spot a version of " & vbCrLf & cstrStFileName & _
        vbCrLf & "in Path " & cstrPath, vbInformation, cstrMsgTitle
    GoTo end_here
  End If
  
  For Each wb In Workbooks
    If LCase(wb.Name) = LCase(strWbVersion) Then
      Set wbUpdate = wb
      Exit For
    End If
  Next wb
  If wbUpdate Is Nothing Then
    If Dir(IIf(Right(cstrPath, 1) = "\", cstrPath, cstrPath & "\") & strWbVersion) <> "" Then
      Set wbUpdate = Workbooks.Open(IIf(Right(cstrPath, 1) = "\", cstrPath, cstrPath & "\") & strWbVersion)
    Else
      MsgBox "Could not find '" & strWbVersion & "' in " & cstrPath & ". Please open workbook and start again.", vbInformation, cstrMsgTitle
      GoTo end_here
    End If
  End If
  '///changed for workbook and worksheet
  If Evaluate("ISREF('[" & strWbVersion & "]" & cstrShFacility & "'!A1)") Then
    Set wsFacility = wbUpdate.Sheets(cstrShFacility)
  Else
    MsgBox "Sheet '" & cstrShFacility & "' not found in workbook '" & strWbVersion, vbInformation, cstrMsgTitle
    GoTo end_here
  End If
  
  lngLastRow = wsUpdate.Range("A" & wsUpdate.Rows.Count).End(xlUp).Row
  
  With wsFacility
    wsUpdate.Range("J13").Value = .Range("A2:A685").SpecialCells(xlCellTypeVisible)
    For lngLooper = 11 To 18
      If wsUpdate.Cells(lngLooper, "C") <> wsUpdate.Cells(lngLooper, "F") And wsUpdate.Cells(lngLooper, "F") <> "" Then
        .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Font.Color = vbRed
        .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Value = wsUpdate.Cells(lngLooper, "F").Value
      Else
        If wsUpdate.Cells(lngLooper, "F") = "" Then
          .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Value = _
              .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Value
        End If
      End If
    Next lngLooper
  End With
  
'  Call LineColorCells   'unable to test
'
'  Call DoLineMath1      'unable to test

end_here:
  Application.ScreenUpdating = True
  Set wsUpdate = Nothing
  Set wsFacility = Nothing
  Set wbFacility = Nothing
  Exit Sub

err_handle:
  MsgBox "Error occurred, refer to the Immediate Window for more information", vbInformation, "Sorry..."
  Debug.Print Now
  Debug.Print "Error Number: " & Err.Number
  Debug.Print "Error Description: " & Err.Description
  Err.Clear
  On Error GoTo 0
  Resume end_here

End Sub

Ciao,
Holger

 

[HaHoBe]

Hi Nlhicks,

this should be the codeline causing the trouble:

  lngLastRow = wsUpdate.Range("A" & wsUpdate.Rows.Count).End(xlUp).Row

Depending on how many rows are filled this line will get the last filled row. If no data is found in the given column the line of the header would be taken as reference (meaning lngLastRow will be 1 covering the range for Row 1 and Row 2). So is it correct to search "Line Update" for the last row? A small adjustment should help

  lngLastRow = WorksheetFunction.Max(wsUpdate.Range("A" & wsUpdate.Rows.Count).End(xlUp).Row, 2)

as this would apply the code only starting on Row 2.

Ciao,
Holger

 

[HaHoBe]

Hi Nlhicks,

rewrite what code to what new code and which parts to take and what to change? Please keep in mind that all I have is the code supplied here. Without seeing what happens where (or better what should be done where) I sadly decided to start all over again. And here we start with a question for your procedure DoLineMath1 (which happens to be the first I worked on): could you please refer to the comments posted in the code part and explain why the contents of different cells should be written into the same target cells? And what about the check for empty cells?

    'not clear what the following check should do: on my system the check returns True if all cells are empty -->
        'why clear the contents of the cells?
    '/// code changed to clear values if at least one cell shows a value
    If WorksheetFunction.CountA(.Range("F11,F13,F18,F17")) > 0 Then
      .Range("L13, M13,O13,P13") = ""
    Else
      For i = 0 To 1
        'for 0 Checked Addresses C11 and F11, Target L13
        'for 1 Checked Addresses C11 and F11, Target L13
        '/// identical cells abd both target for the same cell???
        If .Cells(11, "C").Value <> .Cells(11, "F").Value Then
          .Cells(13, "L").Value = .Cells(11, "F") - .Cells(11, "C")
        End If
        'for 0 Checked Addresses C13 and F13, Target M13
        'for 1 Checked Addresses C14 and F14, Target M13
        '/// both target for the same cell???
        If .Cells(13 + i, "C").Value <> .Cells(13 + i, "F").Value Then
          .Cells(13, "M").Value = .Cells(13, "F") - .Cells(13, "C")
        End If
        'for 0 Checked Addresses C15 and F15, Target O13
        'for 1 Checked Addresses C16 and F16, Target O13
        '/// both target for the same cell???
        If .Cells(15 + i, "C").Value <> .Cells(15 + i, "F").Value Then
          .Cells(13, "O").Value = .Cells(15, "F") - .Cells(15, "C")
        End If
        'for 0 Checked Addresses C17 and F17, Target P13
        'for 1 Checked Addresses C18 and F18, Target P13
        '/// both target for the same cell???
        If .Cells(17 + i, "C").Value <> .Cells(17 + i, "F").Value Then
          .Cells(13, "P").Value = .Cells(17, "F") - .Cells(17, "C")
        End If
      Next i
    End If

Holger

 

[HaHoBe]

Hi Nlhicks,

the last filled row wil be found by

  lngLastRow =  wsUpdate.Range("A" & wsUpdate.Rows.Count).End(xlUp).Row

and will differ whether there are rows hidden by AutoFilter thereafter or not.

And as I left AutoFilter and filtered data out this may solve some problems:

  With wsFacility
    wsUpdate.Range("J13").Value = .Range("A2:A685").SpecialCells(xlCellTypeVisible)
    For lngLooper = 11 To 18
      If wsUpdate.Cells(lngLooper, "C") <> wsUpdate.Cells(lngLooper, "F") And wsUpdate.Cells(lngLooper, "F") <> "" Then
'        .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Font.Color = vbRed
'        .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Value = wsUpdate.Cells(lngLooper, "F").Value
        .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).SpecialCells(xlCellTypeVisible).Font.Color = vbRed
        .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).SpecialCells(xlCellTypeVisible).Value = wsUpdate.Cells(lngLooper, "F").Value
     Else
        If wsUpdate.Cells(lngLooper, "F") = "" Then
'          .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Value = _
'              .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Value
          .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).SpecialCells(xlCellTypeVisible).Value = _
              .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).SpecialCells(xlCellTypeVisible).Value
        End If
      End If
    Next lngLooper
  End With

If I could not only read your postings but understand them (and maybe even read and understand the comments) I think we would be finished by now - still reworking code and I think it will take until tomorrow to finish.

Holger

 

[HaHoBe]

Hi Nlhicks,

I'd prefer not to rebuild the code I supplied as the last version but start with the code which was presented in the opening post. I have changed some names in order to be able to compile the procedure and would ask you to run the code and see if it does what you want (I suspect myself to have made the fatal error right at the very start when modifying this procedure). If everything is fine: stay with that code as it will deliver what you want.

I put in some comments to point out what has been changed. Using With-End With clauses without referring to the objects from there just gives more codelines and does not really help as one aspect is to shorten codelines and references. And if you indent the codelines like I did it will put the code further out to the right (my setting is 2 for Tab, normal setting is 4).

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.

'/// starting code for this thread
'/// changes marked by comments starting with '///
'/// HaHoBe, 20221203

Dim RngRange01 As Range
'/// Wb is dimmed but not used in this procedure
Dim Wb As Workbook
'/// changed Sheet2 to Sheet1 as that is being referenced in the code
'/// Sheet1 is a codename for a worksheet, not really a good choice for a variable
'Dim LineUpdate As Worksheet, Sheet2 As Worksheet
Dim LineUpdate As Worksheet, Sheet1 As Worksheet
'/// Ws for me is associated with Worksheet not a Range
Dim Ws As Range
'/// RowZ is dimmed but not used in this procedure
Dim Rowz As Integer

Application.ScreenUpdating = False
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)")
'/// Ws is set but not used in further codelines
Set Ws = Sheet1.UsedRange
'/// a sheet is laid out to be used to shorten the code but in every codeline thereafter LineUpdate is used for a qualified range
With LineUpdate
  '/// uncommented codeline and replaced RngRang01 with RngRange01
  '/// usually a range is set  to an object and not a row given to it (that's more likely for a Long, Integer, Double etc.)
  'RngRang01 = Range("A" & Rows.Count).End(xlUp).Row
  RngRange01 = Range("A" & Rows.Count).End(xlUp).Row
  '/// a cell is laid to be used thereafter as reference but not used
  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
  
    '/// ran replace for making RngRang01 RngRange01
    If LineUpdate.Range("C15") <> LineUpdate.Range("F15") And LineUpdate.Range("F15") <> "" Then
      Sheet1.Range("F2:F").Font.Color = vbRed
      Sheet1.Range("F2:F" & RngRange01).Value = LineUpdate.Range("F15").Value
    Else
      If LineUpdate.Range("F15") = "" Then
        Sheet1.Range("F2:F" & RngRange01).Value = Sheet1.Range("F2:F" & RngRange01).Value
      End If
    End If
  
    If LineUpdate.Range("C16") <> LineUpdate.Range("F16") And LineUpdate.Range("F16") <> "" Then
      Sheet1.Range("G2:G" & RngRange01).Font.Color = vbRed
      '/// replaced WLineUpdate with LineUpdate
      'Sheet1.Range("G2:G" & RngRange01).Value = WLineUpdate.Range("F16").Value
      Sheet1.Range("G2:G" & RngRange01).Value = LineUpdate.Range("F16").Value
    Else
      If LineUpdate.Range("F16") = "" Then
        Sheet1.Range("G2:G" & RngRange01).Value = Sheet1.Range("G2:G" & RngRange01).Value
      End If
    End If
  
    If LineUpdate.Range("C17") <> LineUpdate.Range("F17") And LineUpdate.Range("F17") <> "" Then
      Sheet1.Range("H2:H" & RngRange01).Font.Color = vbRed
      Sheet1.Range("H2:H" & RngRange01).Value = LineUpdate.Range("F17").Value
    Else
      If LineUpdate.Range("F17") = "" Then
        Sheet1.Range("H2:H" & RngRange01).Value = Sheet1.Range("H2:H" & RngRange01).Value
      End If
    End If
  
    If LineUpdate.Range("C18") <> LineUpdate.Range("F18") And LineUpdate.Range("F18") <> "" Then
      Sheet1.Range("I2:I" & RngRange01).Font.Color = vbRed
      Sheet1.Range("I2:I" & RngRange01).Value = LineUpdate.Range("F18").Value
    Else
      If LineUpdate.Range("F18") = "" Then
        Sheet1.Range("I2:I" & RngRange01).Value = Sheet1.Range("I2:I" & RngRange01).Value
      End If
    End If
  
    'Worksheets("Line Update").Activate
  End With
End With

'/// commented next codeline in order to check only this code
'Call LineColorCells

'/// commented next codeline in order to check only this code
'Call DoLineMath1
Application.ScreenUpdating = True

End Sub

Ciao,
Holger

 

[HaHoBe]

Hi Nlhcks,

as I had worked on each of the procedures on it's own a lot of code is used more than once and the names are not really consistent. Except for LineUpdate1 this could be one way to go (introducing two new subs):

Function HighestVersion(FolderName As String, _
                        Ext As String, _
                        StartFileName As String) As String
' https://www.mrexcel.com/board/threads/run-my-master-workbook-and-call-another-non-macro-enabled-workbook-and-do-the-edits-to-it-prior-to-saving.1223414/
' adapted from: https://www.mrexcel.com/board/threads/find-the-latest-version.1222956/
' finding the highest version number for files starting with a given name and type
' check for Folder before starting FSO

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 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

Const cstrMsgTitle As String = "Ending DoLineMath1"
'

Sub MrE_1223414_1615014_DoLineMath1_New()
' https://www.mrexcel.com/board/threads/run-my-master-workbook-and-call-another-non-macro-enabled-workbook-and-do-the-edits-to-it-prior-to-saving.1223414/
' Updated: 20221202
' Reason:  Reworked Code
  Dim blnEnd            As Boolean
  Dim lngCounter        As Long
  Dim wbkData           As Workbook
  Dim wksWork           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 = "Line Update"

  GetWorkbook_Worksheet cstrPath, cstrWbData, wbkData, cstrShData, wksWork

  If wbkData Is Nothing Then
    MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  If wksWork Is Nothing Then
    MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If

  With wksWork
    'not clear what the following check should do: on my system the check returns True if all cells are empty -->
        'why clear the contents of the cells?
    '/// code changed to clear values if at least one cell shows a value
    If WorksheetFunction.CountA(.Range("F11,F13,F18,F17")) > 0 Then
      .Range("L13, M13,O13,P13") = ""
    Else
      For lngCounter = 0 To 1
        'for 0 Checked Addresses C11 and F11, Target L13
        'for 1 Checked Addresses C11 and F11, Target L13
        '/// identical cells abd both target for the same cell???
        If .Cells(11, "C").Value <> .Cells(11, "F").Value Then
          .Cells(13, "L").Value = .Cells(11, "F") - .Cells(11, "C")
        End If
        'for 0 Checked Addresses C13 and F13, Target M13
        'for 1 Checked Addresses C14 and F14, Target M13
        '/// both target for the same cell???
        If .Cells(13 + lngCounter, "C").Value <> .Cells(13 + lngCounter, "F").Value Then
          .Cells(13, "M").Value = .Cells(13, "F") - .Cells(13, "C")
        End If
        'for 0 Checked Addresses C15 and F15, Target O13
        'for 1 Checked Addresses C16 and F16, Target O13
        '/// both target for the same cell???
        If .Cells(15 + lngCounter, "C").Value <> .Cells(15 + lngCounter, "F").Value Then
          .Cells(13, "O").Value = .Cells(15, "F") - .Cells(15, "C")
        End If
        'for 0 Checked Addresses C17 and F17, Target P13
        'for 1 Checked Addresses C18 and F18, Target P13
        '/// both target for the same cell???
        If .Cells(17 + lngCounter, "C").Value <> .Cells(17 + lngCounter, "F").Value Then
          .Cells(13, "P").Value = .Cells(17, "F") - .Cells(17, "C")
        End If
      Next lngCounter
    End If
  End With
  
end_here:
  Workbook_Worksheet2Nothing wbkData, wksWork
  If blnEnd Then End
End Sub

Const cstrMsgTitle As String = "Ending Line_Bold_in_Concatenate1"
'

Public Sub MrE_1223414_Line_Bold_in_Concatenate1_New()
' https://www.mrexcel.com/board/threads/run-my-master-workbook-and-call-another-non-macro-enabled-workbook-and-do-the-edits-to-it-prior-to-saving.1223414/
' Updated: 20221202
' Reason:  Reworked Code
  Dim wbkData           As Workbook
  Dim wksWork           As Worksheet
  Dim blnEnd            As Boolean

  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 = "Line Update"

  GetWorkbook_Worksheet cstrPath, cstrWbData, wbkData, cstrShData, wksWork

  If wbkData Is Nothing Then
    MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  If wksWork Is Nothing Then
    MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  
  With wksWork
    'assuming that the cells are all located on the same sheet
    '??? Range("Q13") is used two-times ???
    .Range("C32").Value = ("(" & .Range("L11") & " " & .Range("K13") & " " & .Range("L13") & " " & .Range("Q13") & " " & _
        "," & " " & .Range("O11") & " " & .Range("N13") & " " & .Range("O13") & " " & .Range("Q13") & ")")
    .Range("C32").Font.Bold = True
  End With

end_here:
  Workbook_Worksheet2Nothing wbkData, wksWork
  If blnEnd Then End

End Sub

Const cstrMsgTitle As String = "Ending LineColorCells"
'

Sub MrE_1223414_1615014_LineColorCells_New()
' https://www.mrexcel.com/board/threads/run-my-master-workbook-and-call-another-non-macro-enabled-workbook-and-do-the-edits-to-it-prior-to-saving.1223414/
' Updated: 20221202
' Reason:  Reworked Code
  Dim blnEnd            As Boolean
  Dim lngLastRow        As Long
  Dim wbkData           As Workbook
  Dim wksWork           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 = "Facility Ratings & SOLs (Lines)"

  GetWorkbook_Worksheet cstrPath, cstrWbData, wbkData, cstrShData, wksWork

  If wbkData Is Nothing Then
    MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  If wksWork Is Nothing Then
    MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  
  With wksWork
    lngLastRow = .Range("B" & .Rows.Count).End(xlUp).Row
    With .Range("A2:N" & lngLastRow).SpecialCells(xlCellTypeVisible).Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .ColorIndex = 34
      .TintAndShade = 0
      .PatternTintAndShade = 0
    End With
  End With

end_here:
  Workbook_Worksheet2Nothing wbkData, wksWork
  If blnEnd Then End
End Sub

Const cstrMsgTitle As String = "Ending LineUpdate"
'

Sub MrE_1223414_1615014_LineUpdate_New()
' https://www.mrexcel.com/board/threads/run-my-master-workbook-and-call-another-non-macro-enabled-workbook-and-do-the-edits-to-it-prior-to-saving.1223414/
'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: 20221202
' Reason:  Reworked Code
  Dim blnEnd            As Boolean
  Dim lngLastRow        As Long
  Dim lngLooper         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 = "Line Update"

  Const cstrStFileName  As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"
  Const cstrShFacility  As String = "Facility Ratings & SOLs (Lines)"
  
  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
  
  lngLastRow = WorksheetFunction.Max(wksFrom.Range("A" & wksFrom.Rows.Count).End(xlUp).Row, 2)
 
  With wksWorkOn
    wksFrom.Range("J13").Value = .Range("A2:A685").SpecialCells(xlCellTypeVisible)
    For lngLooper = 11 To 18
      If wksFrom.Cells(lngLooper, "C") <> wksFrom.Cells(lngLooper, "F") And wksFrom.Cells(lngLooper, "F") <> "" Then
        .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).SpecialCells(xlCellTypeVisible).Font.Color = vbRed
        .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).SpecialCells(xlCellTypeVisible).Value = wksFrom.Cells(lngLooper, "F").Value
      Else
        If wksFrom.Cells(lngLooper, "F") = "" Then
          .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).SpecialCells(xlCellTypeVisible).Value = _
              .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).SpecialCells(xlCellTypeVisible).Value
        End If
      End If
    Next lngLooper
  End With
  
'  Call LineColorCells   'unable to test
'
'  Call DoLineMath1      'unable to test

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

End Sub

I placed each codesegment is in it's own module.

Holger

 

[HaHoBe]

Hi Nlhicks,

could you please specify which code and what procedure you referring to? I tend to believe it's LineUpdate1 but I have a couple of these and would like to limit the search to only the code you are having trouble with.

GetWorkbook_Worksheet cstrPath, cstrWbData, wbkData, cstrShData, wksFrom

I guess this comes from MrE_1223414_1615014_LineUpdate_New. A look at the dims:

  Dim wbkData           As Workbook     'data workbook, to be filled from Sub
  Dim wksFrom           As Worksheet    'data workbook, to be filled from Sub
  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 = "Line Update"

  Const cstrStFileName  As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"
  Const cstrShFacility  As String = "Facility Ratings & SOLs (Lines)"
 
  GetWorkbook_Worksheet cstrPath, cstrWbData, wbkData, cstrShData, wksFrom

The variables wbkData as well as wksFrom are used as empty parameters and will be filled after GetWorkbook_Worksheet has been finished. From the codeline after the one you mentioned the variables will be checked and if everything is correct hold the proper object to the wanted workbook and worksheet.

Holger

 

[HaHoBe]

Hi Nlhicks,

the latest version I posted is from #49 and was a slightly modified version of the opening post where I did not implement any new parts.

What I look at is something that I would still solve in taking every single row of the data range and fitting that in into the filtered area - even with my version of Excel 2019 copied data is filled in chronologicly starting with the first visible row and putting in the other rows just below (if you will: ignoring that any user wants to fill only the visible cells).

It will take a little time to adapt as I never realized that a part of the code you posted wasn't working the way you wanted it to.

Holger

 

[HaHoBe]

Hi Nlhicks,

looking at the pictures I found that the target should not be a range but a single cell instead: a cell from the first visible row on "Facility Ratings & SOLs (Lines)" after the heading.

I tried to fully qualify all ranges giving them the object for the sheet and changed some lines in order to make this code easier to maintain by using a With for each target cell. Only if the code does what it should do we can take the step to use a loop in order to shorten the code and work on setting the objects for teh workbooks and worksheets (but that is future...).

Sub LineUpdate1_mod221205()
'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.

'/// starting code for this thread
'/// modified by HaHoBe, 20221205

Dim lngTarget         As Long
Dim wsLineUpdate      As Worksheet
Dim wsSOLines         As Worksheet

Application.ScreenUpdating = False
Windows("WAPA-UGPR Facility Rating and SOL Record (Master).xlsm").Activate
Sheets("Line Update").Activate
Set wsLineUpdate = 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 wsSOLines = Sheets("Facility Ratings & SOLs (Lines)")

With wsSOLines
  lngTarget = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1).Row
  wsLineUpdate.Range("J13").Value = .Range("A2:A685").SpecialCells(xlCellTypeVisible).Cells.Count

  With .Range("B" & lngTarget)
    If wsLineUpdate.Range("C11") <> wsLineUpdate.Range("F11") And wsLineUpdate.Range("F11") <> "" Then
      .Font.Color = vbRed
      .Value = wsLineUpdate.Range("F11").Value
    Else
      If wsLineUpdate.Range("F11") = "" Then
        .Value = .Value
      End If
    End If
  End With
  
  With .Range("C" & lngTarget)
    If wsLineUpdate.Range("C12") <> wsLineUpdate.Range("F12") And wsLineUpdate.Range("F12") <> "" Then
      .Font.Color = vbRed
      .Value = wsLineUpdate.Range("F12").Value
    Else
      If wsLineUpdate.Range("F12") = "" Then
        .Value = .Value
      End If
    End If
  End With

  With .Range("D" & lngTarget)
    If wsLineUpdate.Range("C13") <> wsLineUpdate.Range("F13") And wsLineUpdate.Range("F13") <> "" Then
      .Font.Color = vbRed
      .Value = wsLineUpdate.Range("F13").Value
    Else
      If wsLineUpdate.Range("F13") = "" Then
        .Value = .Value
      End If
    End If
  End With

  With .Range("E" & lngTarget)
    If wsLineUpdate.Range("C14") <> wsLineUpdate.Range("F14") And wsLineUpdate.Range("F14") <> "" Then
      .Font.Color = vbRed
      .Value = wsLineUpdate.Range("F14").Value
    Else
      If wsLineUpdate.Range("F14") = "" Then
        .Value = .Value
      End If
    End If
  End With

  With .Range("F" & lngTarget)
    If wsLineUpdate.Range("C15") <> wsLineUpdate.Range("F15") And wsLineUpdate.Range("F15") <> "" Then
      .Font.Color = vbRed
      .Value = wsLineUpdate.Range("F15").Value
    Else
      If wsLineUpdate.Range("F15") = "" Then
        .Value = .Value
      End If
    End If
  End With
  
  With .Range("G" & lngTarget)
    If wsLineUpdate.Range("C16") <> wsLineUpdate.Range("F16") And wsLineUpdate.Range("F16") <> "" Then
      .Font.Color = vbRed
      .Value = wsLineUpdate.Range("F16").Value
    Else
      If wsLineUpdate.Range("F16") = "" Then
        .Value = .Value
      End If
    End If
  End With

  With .Range("H" & lngTarget)
    If wsLineUpdate.Range("C17") <> wsLineUpdate.Range("F17") And wsLineUpdate.Range("F17") <> "" Then
      .Font.Color = vbRed
      .Value = wsLineUpdate.Range("F17").Value
    Else
      If wsLineUpdate.Range("F17") = "" Then
        .Value = .Value
      End If
    End If
  End With

  With .Range("I" & lngTarget)
    If wsLineUpdate.Range("C18") <> wsLineUpdate.Range("F18") And wsLineUpdate.Range("F18") <> "" Then
      .Font.Color = vbRed
      .Value = wsLineUpdate.Range("F18").Value
    Else
      If wsLineUpdate.Range("F18") = "" Then
        .Value = .Value
      End If
    End If
  End With

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

'/// commented next codeline in order to check only this code
'Call LineColorCells

'/// commented next codeline in order to check only this code
'Call DoLineMath1
Set wsSOLines = Nothing
Set wsLineUpdate = Nothing
Application.ScreenUpdating = True

End Sub

Ciao,
Holger

 

[HaHoBe]

Hi Nlhicks,

by working on the code and checking Function HighestVersion I realized that in that function parameter Ext is not used as I took care of the position of the last dot to limit the amount of characters for the running number. On my testsystem the function delivers the correct filename which is used further in the code. If you have double checked the path and names of workbooks inside that folder and no changes are needed but the proper workbook still is not chosen I could integrate a Filepicker as dialog to choose from there (or implement an UserForm which would limit the number of choices more than an integrated dialog).

Here is my latest try for LineUpdate:

Const cstrMsgTitle As String = "Ending LineUpdate"
'

Sub MrE_1223414_1615014_LineUpdate_New221205()
' https://www.mrexcel.com/board/threads/run-my-master-workbook-and-call-another-non-macro-enabled-workbook-and-do-the-edits-to-it-prior-to-saving.1223414/
'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 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 = "Line Update"

  Const cstrStFileName  As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"
  Const cstrShFacility  As String = "Facility Ratings & SOLs (Lines)"
 
  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
    lngTarget = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1).Row
    wksFrom.Range("J13").Value = .Range("A2:A685").SpecialCells(xlCellTypeVisible).Cells.Count
    For lngLooper = 11 To 18
      With .Cells(lngTarget, lngLooper - 9)
        If wksFrom.Cells(lngLooper, "C") <> wksFrom.Cells(lngLooper, "F") And wksFrom.Cells(lngLooper, "F") <> "" Then
          .Font.Color = vbRed
          .Value = wksFrom.Cells(lngLooper, "F").Value
        Else
          If wksFrom.Cells(lngLooper, "F") = "" Then
            .Value = .Value
          End If
        End If
      End With
    Next lngLooper
  End With
 
'  Call LineColorCells   'unable to test
'
'  Call DoLineMath1      'unable to test

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

End Sub

Ciao,
Holger