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]

Windows("WAPA-UGPR Facility Rating and SOL Record (Test Workbook).xlsm").Activate (Subscript out of range) This should be (Data File)_vxxx.xlsm which incorporates the nifty trick you wrote to ignore version numbers.
Once you fix that then it works perfectly as shown below

 

[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

 

[Nlhicks]

You are a truly gifted man Holger, thank you that worked perfectly

 

[HaHoBe]

Hi Nlhicks,

glad to finally deliver a working set of codes.

If you could be satisfied with just filling the background for Columns B to I (merging code from MrE_1223414_1615014_LineColorCells_New at least partly) and using a dimmed variable:

Const cstrMsgTitle As String = "Ending LineUpdate"
'

Sub MrE_1223414_1615014_LineUpdate_New221205_mod2()
' 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
    lngLastRow = .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(lngLastRow, lngLooper - 9)
        If wksFrom.Cells(lngLooper, "C") <> wksFrom.Cells(lngLooper, "F") And wksFrom.Cells(lngLooper, "F") <> "" Then
          .Font.Color = vbRed
          With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ColorIndex = 34
            .TintAndShade = 0
            .PatternTintAndShade = 0
          End With
          .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 DoLineMath1      'commented out for test

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

End Sub

Holger

 

[HaHoBe]

Or using a boolean to spot if any change is made from B to I and only then Colour A to N:

Const cstrMsgTitle As String = "Ending LineUpdate"
'

Sub MrE_1223414_1615014_LineUpdate_New221205_mod3()
' 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 blnColour         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
  
  blnColour = False
  
  With wksWorkOn
    lngLastRow = .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(lngLastRow, 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
          blnColour = True
        Else
          If wksFrom.Cells(lngLooper, "F") = "" Then
            .Value = .Value
          End If
        End If
      End With
    Next lngLooper
    If blnColour Then
      With .Range("A" & lngLastRow & ":N" & lngLastRow).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 34
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
    End If
  End With
  
'  Call DoLineMath1      'commented out for test

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

End Sub

Holger

 

[Nlhicks]

So, the highlight needs to cover the entire row so when a person opens the spreadsheet and quickly scrolls over the contents the highlighted row is very obvious and pops out to them.

 

[Nlhicks]

Never mind on my last comment the highlighting is perfect. This is exactly what I was trying to get done thank you so very much. Now I am going to try to work on the domath and concat functions to see if they are okay.

 

[Nlhicks]

I tried the DoMath and nothing happened. This do Math works perfect within the master workbook however, Cell J13 needs to take the value of the visible cell in column A on the sheet Facility Ratings & SOLs (Lines). Here is my attempt to make that work. Everything is working except getting the value for J13 from the other workbook.


Sub DoLineMath1()

Dim Ws As Worksheet
Dim i As Long
Dim Wb As Workbook
Dim LineUpdate As Worksheet
Dim FacilityRating As Worksheet

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

Set FacilityRating = Sheets("Facility Rating and SOLs (Lines)")

If LineUpdate.Range("F11,F13,F18,F17") = "" Then
LineUpdate.Range("L13, M13,O13,P13") = ""

Else

For i = 0 To 1
If LineUpdate.Cells(11, "C").Value <> LineUpdate.Cells(11, "F").Value Then
LineUpdate.Cells(13, "L").Value = LineUpdate.Cells(11, "F") - LineUpdate.Cells(11, "C")
End If

If LineUpdate.Cells(13 + i, "C").Value <> LineUpdate.Cells(13 + i, "F").Value Then
LineUpdate.Cells(13, "M").Value = LineUpdate.Cells(13, "F") - LineUpdate.Cells(13, "C")
End If

If LineUpdate.Cells(15 + i, "C").Value <> LineUpdate.Cells(15 + i, "F").Value Then
LineUpdate.Cells(13, "O").Value = LineUpdate.Cells(15, "F") - LineUpdate.Cells(15, "C")
End If

If LineUpdate.Cells(17 + i, "C").Value <> LineUpdate.Cells(17 + i, "F").Value Then
LineUpdate.Cells(13, "P").Value = LineUpdate.Cells(17, "F") - LineUpdate.Cells(17, "C")
End If
Next i
End If
LineUpdate.Cells(13, "J").Value = FacilityRating.Cells.Range("A2:A685").SpecialCells(xlCellTypeVisible).Cells.Count


Call Line_Bold_in_Concatenate2

End Sub

 

[Nlhicks]

The line where there is a "1" in it should be copied from the other worksheet and it should say "Great Plains+Great Plains 13.8kV" as stated in Column A of Facility Rating and SOLs (Lines).

 

[Nlhicks]

Never mind, I changed the .Count to .Value and now I have the correct result