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

 

[Zot]

Avoid using Activate. When writing your program you will get confused or hard track which workbook is active. Define everything and use it as reference.

Here is a sample how you can write a macro in a standalone workbook with macro to manipulate data between non-macro Workbook A and non-macro Workbook B. I think it is easy to follow code.

Sub Test()

Dim Fname As Variant
Dim wsA As Worksheet, wsB As Worksheet
Dim wbA As Workbook, wbB As Workbook
Dim rngA As Range, rngB As Range

' Select workbook A and define as wbA
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub                         'CANCEL is clicked
Set wbA = Workbooks.Open(Filename:=Fname, UpdateLinks:=False)

' Define working sheet in wbA. Change sheet name accordingly
Set wsA = wbA.Sheets("Sheet1")

' Select workbook B and define as wbB
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub                         'CANCEL is clicked
Set wbB = Workbooks.Open(Filename:=Fname, UpdateLinks:=False)

' Define working sheet in wbB. Change sheet name accordingly
Set wsB = wbB.Sheets("Sheet1")

' Example on how to copyi data from wsA to wsB
wsA.Range("A1").Copy wsB.Range("A6")
wsA.Range("B1").Copy wsB.Range("B6")

End Sub

 

[HaHoBe]

Hi NlHicks,

I am getting an error on the line RngRang01 = Range("A" & Rows.Count).End(xlUp).Row

According to the Dims it should be

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

and it will refer to Sheets("Facility Ratings & SOLs (Lines)") which should be active by that time.

While you refer to RngRange01 (without setting a value) at the start of the procedure you change to work with RngRang01 starting with "C15".

Full code may look like

Sub MrE_1223414_LineUpdate()
' 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
  
  Const cstrFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Test Workbook).xlsm"

  Application.ScreenUpdating = False
  On Error GoTo err_handle
  Set wbFacility = Workbooks(cstrFacility)
  Set wsUpdate = wbFacility.Sheets("Line Update")
  Set wsFacility = wbFacility.Sheets("Facility Ratings & SOLs (Lines)")
  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

You should consider to turn on Option Explicit for using only dimmed Variables.

Ciao,
Holger

 

[HaHoBe]

Hi NlHicks,

please have a look at How to Post Your VBA Code to display code here.

Thanks in advance.

Questions by now:

• procedure DoLineMath1: you are using a loop but refering to the same target cells (and the loop does not affect the first If) - I'm having trouble to understand the reason for that.
• procedure Line_Bold_in_Concatenate1: you reference a lot of cells for the concatenation, could you explain on which sheet the result cell is located?

Sub LineColorCells()
' 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/
Dim LR As Long
Dim wbToOpen As Workbook
Dim wsLines As Worksheet

Set wbToOpen = Workbooks.Open(Filename:="WAPA-UGPR Facility Rating and SOL Record (Data File)_v159.xlsx")
Set wsLines = wbToOpen.Sheets("Facility Ratings & SOLs (Lines)")
With wsLines
  LR = .Range("B" & .Rows.Count).End(xlUp).Row
  With .Range("A2:N" & LR).SpecialCells(xlCellTypeVisible).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ColorIndex = 34
    .TintAndShade = 0
    .PatternTintAndShade = 0
  End With
End With
Set wsLines = Nothing
Set wbToOpen = Nothing
End Sub

I haven't had time to look at FindRightRow1 by now and will be off for the next 3 to 4 hours.

Holger

 

[HaHoBe]

Hi NlHicks,

code from above, some additional checks added:

Sub MrE_1223414_LineColorCells()
' 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/
  Dim LR As Long
  Dim wbToOpen As Workbook
  Dim wsLines As Worksheet
  
  Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v159.xlsx"
  Const cstrShFacility As String = "Facility Ratings & SOLs (Lines)"

  If Dir(cstrWbFacility) <> 0 Then
    Set wbToOpen = Workbooks.Open(Filename:=cstrWbFacility)
  Else
    MsgBox "Could not find '" & cstrWbFacility & "' in current folder. Please open workbook and start again.", vbInformation, "Ending here"
    GoTo end_here
  End If
  If Evaluate("ISREF('" & cstrShFacility & "'!A1)") Then
    Set wsLines = wbToOpen.Sheets(cstrShFacility)
  Else
    MsgBox "Sheet '" & cstrShFacility & "' not found in workbook '" & cstrWbFacility, vbInformation, "Ending here"
    GoTo end_here
  End If

  With wsLines
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    With .Range("A2:N" & LR).SpecialCells(xlCellTypeVisible).Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .ColorIndex = 34
      .TintAndShade = 0
      .PatternTintAndShade = 0
    End With
  End With

end_here:
  Set wsLines = Nothing
  Set wbToOpen = Nothing
End Sub

Sub MrE_1223414_LineUpdate_mod()
' 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
  
  Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Test Workbook).xlsm"
  Const cstrShFacility As String = "Facility Ratings & SOLs (Lines)"
  Const cstrUpdate As String = "Line Update"

  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
  If Evaluate("ISREF('" & 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
  If Evaluate("ISREF('" & cstrShFacility & "'!A1)") Then
    Set wsFacility = wbFacility.Sheets(cstrShFacility)
  Else
    MsgBox "Sheet '" & cstrShFacility & "' not found in workbook '" & cstrWbFacility, vbInformation, "Ending here"
    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

 

[HaHoBe]

I can't figure out where the range C32 is located:

Public Sub MrE_1223414_Line_Bold_in_Concatenate1()
' 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/
  Dim wsUpdate As Worksheet

  Const cstrUpdate As String = "Line Update"
  If Evaluate("ISREF('" & cstrUpdate & "'!A1)") Then
    Set wsUpdate = Sheets(cstrUpdate)
  Else
    MsgBox "Sheet '" & cstrUpdate & "' not found in workbook.", vbInformation, "Ending here"
    GoTo end_here
  End If

  With wsUpdate
    'not clear on which sheet Range("C32") is located: the active sheet (which one), the referenced sheet, an other 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:
  Set wsUpdate = Nothing
End Sub

I mentioned before that I have trouble understanding the loop as the cells which will be altered will be the same for all Ifs and both loops. This code needs further work on the loop:

Sub MrE_1223414_DoLineMath1()
' 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/
  Dim i As Long
  Dim wb As Workbook
  Dim wbFacility As Workbook
  Dim wsUpdate As Worksheet

  Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
  Const cstrUpdate As String = "Line 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('" & 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

  With wsUpdate
    '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
        'first if is the same for both loops????
        If .Cells(11, "C").Value <> .Cells(11, "F").Value Then
          .Cells(13, "L").Value = .Cells(11, "F") - .Cells(11, "C")
        End If
        'any of the following Ifs will check different cells but write to 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
        If .Cells(15 + i, "C").Value <> .Cells(15 + i, "F").Value Then
          .Cells(13, "O").Value = .Cells(15, "F") - .Cells(15, "C")
        End If
        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
  End With
  
'  Call Line_Bold_in_Concatenate1

end_here:
  Set wsUpdate = Nothing
  Set wbFacility = Nothing
  Exit Sub

End Sub

Trouble understandiong what you want to be filled into the cells - as I still use Excel2019 I would need to further specify that and have commented out how it may look for my system. I cahnged the code when looking at ranges to be filled as well and would need information on what you really want to check there:

Sub MrE_1223414_FindRightRow1()
' 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/

  Dim Rowz As Integer
  Dim wb As Workbook
  Dim wbFacility As Workbook
  Dim wsUpdate As Worksheet
  Dim wsFacility As Worksheet
  Dim sValue As String

  Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
  Const cstrShFacility As String = "Facility Ratings & SOLs (Lines)"
  Const cstrUpdate As String = "Line 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('" & 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
  If Evaluate("ISREF('" & cstrShFacility & "'!A1)") Then
    Set wsFacility = wbFacility.Sheets(cstrShFacility)
  Else
    MsgBox "Sheet '" & cstrShFacility & "' not found in workbook '" & cstrWbFacility, vbInformation, "Ending here"
    GoTo end_here
  End If

  Application.ScreenUpdating = False
  
  With wsFacility
    If wsUpdate.Range("D5").Value <> "" Then
      .Range("A1").CurrentRegion.AutoFilter field:=10, Criteria1:="*" & wsUpdate.Range("D5") & "*"
    End If
    If wsUpdate.Range("D6").Value <> "" Then
      .Range("A1").CurrentRegion.AutoFilter field:=11, Criteria1:="*" & wsUpdate.Range("D6") & "*"
    End If
    If wsUpdate.Range("D7").Value <> "" Then
      .Range("A1").CurrentRegion.AutoFilter field:=37, Criteria1:="" & wsUpdate.Range("D7") & ""
    End If
    'changed to let the function look for the used range in Column A
    Rowz = Application.WorksheetFunction.Subtotal(3, .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row))
    Debug.Print Rowz
    If Rowz <= 1 Then
'      wsUpdate.Range("C11").Value = WorksheetFunction.Sum(.Range("B2:B695").SpecialCells(xlCellTypeVisible))
      wsUpdate.Range("C12").Value = .Range("C2:C695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C13").Value = .Range("D2:D695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C14").Value = .Range("E2:E695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C15").Value = .Range("F2:F695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C16").Value = .Range("G2:G695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C17").Value = .Range("H2:H695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C18").Value = .Range("I2:I695").SpecialCells(xlCellTypeVisible)
      GoTo Skip
    ElseIf Rowz > 1 Then
      GoSub Item_Open
      .Range("A1").CurrentRegion.AutoFilter field:=36, Criteria1:=wsUpdate.Range("H6")
      wsUpdate.Range("C11").Value = .Range("B2:B695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C12").Value = .Range("C2:C695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C13").Value = .Range("D2:D695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C14").Value = .Range("E2:E695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C15").Value = .Range("F2:F695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C16").Value = .Range("G2:G695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C17").Value = .Range("H2:H695").SpecialCells(xlCellTypeVisible)
      wsUpdate.Range("C18").Value = .Range("I2:I695").SpecialCells(xlCellTypeVisible)
Skip:
    End If
  End With

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

Item_Open:
  sValue = Application.InputBox("Enter the TO: Bus Number here, Thank you.")
  wsUpdate.Range("H6").Value = sValue
  Debug.Print sValue
  Return
End Sub

Ciao,
Holger

 

[HaHoBe]

Hi Nlhicks,

regarding #10:

The main macros are FindRightRow() and LineUpdate() since both of those have to be run from the macro workbook but performed on the stored workbook.

You give up "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm" and "WAPA-UGPR Facility Rating and SOL Record (Test Workbook).xlsm" to be the targeted workbooks. What the code should do: check if the workbook is already open in the same instance of Excel, if not try to open it (since there is no path or folder indicated code searches for the workbook in the current directory), if no match is found display a message box to inform the user and quit the procedure without calling any other macros. If an object was set to the workbook check for the sheets to be present in the workbook. If all this has been checked we know we have the proper workbook and needed sheets to proceed and take any action on the sheets as needed.

Regarding #14:

The worksheet Line update is in the workbook WAPA-UGPR Facility Rating and SOL Record (Master).xlsm but the worksheet Facility Ratings & SOLs (Lines) is in the workbook WAPA-UGPR Facility Rating and SOL Record (Data File)_v161.xlsm.

You're right about the procedure FindRightRow1 as I simply missed that point. But the workbook names indicated differ from what you give up by now. So I need to rework my code to take care of 2 workbooks and think about how to find the latest version of one workbook.

Holger

 

[HaHoBe]

Hi Nlhicks,

a new version of FindRightRow which should take care of two workbooks. You would need to alter the Path to the workbooks as I put in a path on my system as example:

Const cstrMsgTitle As String = "MrE_1223414_Ending_here"
'

Sub MrE_1223414_FindRightRow1_02()
' 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/

  Dim Rowz As Integer
  Dim wb As Workbook
  Dim wbMaster As Workbook
  Dim wsLinesMaster As Worksheet
  Dim wbUpdate As Workbook
  Dim wsFacility As Worksheet
  Dim sValue As String
  Dim strFile As String
  Dim strWbVersion As String
  
  
  '//// adjust the path to match, this is my sample for testing \\\'
  Const cstrPath As String = "C:\Result"
  
  Const cstrStFileName As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"

  Const cstrwbMaster As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
  Const cstrMasterUpdate As String = "Line Update"
  Const cstrShFacility As String = "Facility Ratings & SOLs (Lines)"

  '/// 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(cstrwbMaster) Then
      Set wbMaster = wb
      Exit For
    End If
  Next wb
  If wbMaster Is Nothing Then
    If Dir(cstrwbMaster) <> "" Then
      Set wbMaster = Workbooks.Open(cstrwbMaster)
    Else
      MsgBox "Could not find '" & cstrwbMaster & "' in current folder. Please open workbook and start again.", vbInformation, cstrMsgTitle
      GoTo end_here
    End If
  End If
  If Evaluate("ISREF('" & cstrMasterUpdate & "'!A1)") Then
    Set wsLinesMaster = wbMaster.Sheets(cstrMasterUpdate)
  Else
    MsgBox "Sheet '" & cstrMasterUpdate & "' not found in workbook '" & cstrwbMaster, 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
  If Evaluate("ISREF('" & cstrShFacility & "'!A1)") Then
    Set wsFacility = wbUpdate.Sheets(cstrShFacility)
  Else
    MsgBox "Sheet '" & cstrShFacility & "' not found in workbook '" & strWbVersion, vbInformation, cstrMsgTitle
    GoTo end_here
  End If

  Application.ScreenUpdating = False
  
  With wsFacility
    If wsLinesMaster.Range("D5").Value <> "" Then
      .Range("A1").CurrentRegion.AutoFilter field:=10, Criteria1:="*" & wsLinesMaster.Range("D5") & "*"
    End If
    If wsLinesMaster.Range("D6").Value <> "" Then
      .Range("A1").CurrentRegion.AutoFilter field:=11, Criteria1:="*" & wsLinesMaster.Range("D6") & "*"
    End If
    If wsLinesMaster.Range("D7").Value <> "" Then
      .Range("A1").CurrentRegion.AutoFilter field:=37, Criteria1:="" & wsLinesMaster.Range("D7") & ""
    End If
    'changed to let the function look for the used range in Column A
    Rowz = Application.WorksheetFunction.Subtotal(3, .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row))
    Debug.Print Rowz
    If Rowz <= 1 Then
'      wsLinesMaster.Range("C11").Value = WorksheetFunction.Sum(.Range("B2:B695").SpecialCells(xlCellTypeVisible))
      wsLinesMaster.Range("C12").Value = .Range("C2:C695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C13").Value = .Range("D2:D695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C14").Value = .Range("E2:E695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C15").Value = .Range("F2:F695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C16").Value = .Range("G2:G695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C17").Value = .Range("H2:H695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C18").Value = .Range("I2:I695").SpecialCells(xlCellTypeVisible)
      GoTo Skip
    ElseIf Rowz > 1 Then
      GoSub Item_Open
      .Range("A1").CurrentRegion.AutoFilter field:=36, Criteria1:=wsLinesMaster.Range("H6")
      wsLinesMaster.Range("C11").Value = .Range("B2:B695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C12").Value = .Range("C2:C695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C13").Value = .Range("D2:D695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C14").Value = .Range("E2:E695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C15").Value = .Range("F2:F695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C16").Value = .Range("G2:G695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C17").Value = .Range("H2:H695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C18").Value = .Range("I2:I695").SpecialCells(xlCellTypeVisible)
Skip:
    End If
  End With

end_here:
  Set wsLinesMaster = Nothing
  Set wsFacility = Nothing
  Set wbUpdate = Nothing
  Set wbMaster = Nothing
  Application.ScreenUpdating = True
  Exit Sub

Item_Open:
  sValue = Application.InputBox("Enter the TO: Bus Number here, Thank you.")
  wsLinesMaster.Range("H6").Value = sValue
  Debug.Print sValue
  Return
End Sub

You would need to add this function which is called from the procedure and should deliver the highest version from a given path for workbooks starting with a constant:

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/

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

Holger

 

[HaHoBe]

Hi Nlhicks,

change the function to

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

This will check if a valid directory is passed as parameter.

"WAPA-UGPR Facility Rating and SOL Record (Data File)_v161.xlsm" and "WAPA-UGPR Facility Rating and SOL Record (Data File)_v162.xlsm" will both be found by my search string and the hpghest number available be chosen

 Const cstrStFileName As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"

but with the string displayed in the locals window you would not need to search for the highest version number as you hard code the name of the workbook (not

Holger

 

[HaHoBe]

Hi Nlhicks,

that's what happens if the coded is tested on a sample - the check for the available sheets will only be executed in the active workbook.

Instead of (just a sample)

  If Evaluate("ISREF('" & cstrMasterUpdate & "'!A1)") Then

the codeline should be

  If Evaluate("ISREF('[" & cstrWbMaster & "]" & cstrMasterUpdate & "'!A1)") Then

I altered the code for all but for MrE_1223414_Line_Bold_in_Concatenate1 as no indication on the workbook(s) and/or worksheets has been passed by now.

Sub MrE_1223414_DoLineMath1()
' 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/
  Dim i As Long
  Dim wb As Workbook
  Dim wbFacility As Workbook
  Dim wsUpdate As Worksheet

  Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
  Const cstrUpdate As String = "Line 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
  '///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

  With wsUpdate
    '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
        'first if is the same for both loops????
        If .Cells(11, "C").Value <> .Cells(11, "F").Value Then
          .Cells(13, "L").Value = .Cells(11, "F") - .Cells(11, "C")
        End If
        'any of the following Ifs will check different cells but write to 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
        If .Cells(15 + i, "C").Value <> .Cells(15 + i, "F").Value Then
          .Cells(13, "O").Value = .Cells(15, "F") - .Cells(15, "C")
        End If
        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
  End With
  
'  Call Line_Bold_in_Concatenate1

end_here:
  Set wsUpdate = Nothing
  Set wbFacility = Nothing
  Exit Sub

End Sub

Const cstrMsgTitle As String = "MrE_1223414_Ending_here"
'

Sub MrE_1223414_FindRightRow1_02()
' 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/

  Dim Rowz As Integer
  Dim wb As Workbook
  Dim wbMaster As Workbook
  Dim wsLinesMaster As Worksheet
  Dim wbUpdate As Workbook
  Dim wsFacility As Worksheet
  Dim sValue As String
  Dim strFile As String
  Dim strWbVersion As String
  
  
  '//// adjust the path to match, this is my sample for testing \\\'
  Const cstrPath As String = "C:\Rettung"
'  Const cstrPath As String = "C:\Result"
  
  Const cstrStFileName As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"

  Const cstrWbMaster As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
  Const cstrMasterUpdate As String = "Line Update"
  Const cstrShFacility As String = "Facility Ratings & SOLs (Lines)"

  '/// 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(cstrWbMaster) Then
      Set wbMaster = wb
      Exit For
    End If
  Next wb
  If wbMaster Is Nothing Then
    If Dir(cstrWbMaster) <> "" Then
      Set wbMaster = Workbooks.Open(cstrWbMaster)
    Else
      MsgBox "Could not find '" & cstrWbMaster & "' in current folder. Please open workbook and start again.", vbInformation, cstrMsgTitle
      GoTo end_here
    End If
  End If
  '///changed for workbook and worksheet
  If Evaluate("ISREF('[" & cstrWbMaster & "]" & cstrMasterUpdate & "'!A1)") Then
    Set wsLinesMaster = wbMaster.Sheets(cstrMasterUpdate)
  Else
    MsgBox "Sheet '" & cstrMasterUpdate & "' not found in workbook '" & cstrWbMaster, 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

  Application.ScreenUpdating = False
  
  With wsFacility
    If wsLinesMaster.Range("D5").Value <> "" Then
      .Range("A1").CurrentRegion.AutoFilter field:=10, Criteria1:="*" & wsLinesMaster.Range("D5") & "*"
    End If
    If wsLinesMaster.Range("D6").Value <> "" Then
      .Range("A1").CurrentRegion.AutoFilter field:=11, Criteria1:="*" & wsLinesMaster.Range("D6") & "*"
    End If
    If wsLinesMaster.Range("D7").Value <> "" Then
      .Range("A1").CurrentRegion.AutoFilter field:=37, Criteria1:="" & wsLinesMaster.Range("D7") & ""
    End If
    'changed to let the function look for the used range in Column A
    Rowz = Application.WorksheetFunction.Subtotal(3, .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row))
    Debug.Print Rowz
    If Rowz <= 1 Then
'      wsLinesMaster.Range("C11").Value = WorksheetFunction.Sum(.Range("B2:B695").SpecialCells(xlCellTypeVisible))
      wsLinesMaster.Range("C12").Value = .Range("C2:C695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C13").Value = .Range("D2:D695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C14").Value = .Range("E2:E695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C15").Value = .Range("F2:F695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C16").Value = .Range("G2:G695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C17").Value = .Range("H2:H695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C18").Value = .Range("I2:I695").SpecialCells(xlCellTypeVisible)
      GoTo Skip
    ElseIf Rowz > 1 Then
      GoSub Item_Open
      .Range("A1").CurrentRegion.AutoFilter field:=36, Criteria1:=wsLinesMaster.Range("H6")
      wsLinesMaster.Range("C11").Value = .Range("B2:B695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C12").Value = .Range("C2:C695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C13").Value = .Range("D2:D695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C14").Value = .Range("E2:E695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C15").Value = .Range("F2:F695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C16").Value = .Range("G2:G695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C17").Value = .Range("H2:H695").SpecialCells(xlCellTypeVisible)
      wsLinesMaster.Range("C18").Value = .Range("I2:I695").SpecialCells(xlCellTypeVisible)
Skip:
    End If
  End With

end_here:
  Set wsLinesMaster = Nothing
  Set wsFacility = Nothing
  Set wbUpdate = Nothing
  Set wbMaster = Nothing
  Application.ScreenUpdating = True
  Exit Sub

Item_Open:
  sValue = Application.InputBox("Enter the TO: Bus Number here, Thank you.")
  wsLinesMaster.Range("H6").Value = sValue
  Debug.Print sValue
  Return
End Sub

Sub MrE_1223414_LineColorCells()
' 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/
  Dim LR As Long
  Dim wbToOpen As Workbook
  Dim wsLines As Worksheet
  
  Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v159.xlsx"
  Const cstrShFacility As String = "Facility Ratings & SOLs (Lines)"

  If Dir(cstrWbFacility) <> 0 Then
    Set wbToOpen = Workbooks.Open(Filename:=cstrWbFacility)
  Else
    MsgBox "Could not find '" & cstrWbFacility & "' in current folder. Please open workbook and start again.", vbInformation, "Ending here"
    GoTo end_here
  End If
  '///changed for workbook and worksheet
  If Evaluate("ISREF('[" & cstrWbFacility & "]" & cstrShFacility & "'!A1)") Then
    Set wsLines = wbToOpen.Sheets(cstrShFacility)
  Else
    MsgBox "Sheet '" & cstrShFacility & "' not found in workbook '" & cstrWbFacility, vbInformation, "Ending here"
    GoTo end_here
  End If

  With wsLines
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    With .Range("A2:N" & LR).SpecialCells(xlCellTypeVisible).Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .ColorIndex = 34
      .TintAndShade = 0
      .PatternTintAndShade = 0
    End With
  End With

end_here:
  Set wsLines = Nothing
  Set wbToOpen = Nothing
End Sub

Sub MrE_1223414_LineUpdate_mod()
' 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
  
  Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Test Workbook).xlsm"
  Const cstrShFacility As String = "Facility Ratings & SOLs (Lines)"
  Const cstrUpdate As String = "Line Update"

  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
  '///changed for workbook and worksheet
  If Evaluate("ISREF('[" & cstrWbFacility & "]" & cstrShFacility & "'!A1)") Then
    Set wsFacility = wbFacility.Sheets(cstrShFacility)
  Else
    MsgBox "Sheet '" & cstrShFacility & "' not found in workbook '" & cstrWbFacility, vbInformation, "Ending here"
    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,

au contraire: I should have gotten away from my usual routine since I open up workbooks and then check if the sheets are available so the opened workbook will always be the active one. Writing code to look for an already opened workbook is one thing but since that must not be the active one it should be reflected in checking the sheets.

There is some potential in condensing the code especially for checking the workbooks and worksheets and setting objects to them - instead of having the code in each procedure I would tend to have a sub where the parameters are given and objects will be set and returned. A sample of this may look like

Sub ObjectToWbSh(sPath As String, _
                  sWb As String, _
                  sSh As String, _
                  wbReturn As Object, _
                  wsSheet As Object)

Dim wb As Workbook

For Each wb In Workbooks
  If wb.Name = sWb Then
    Set wbReturn = wb
    Exit For
  End If
Next wb

If wbReturn Is Nothing Then
  If Len(Dir(sPath & sWb)) > 0 Then
    Set wbReturn = Workbooks.Open(sPath & sWb)
  Else
    MsgBox sWb & " not to be found in current directory!", vbExclamation, "Cancelled"
    End
  End If
End If

Set wsSheet = wbReturn.Sheets(sSh)

End Sub

Sub ObjectToNothing(wbReturn As Object, wsSheet As Object)

Set wsSheet = Nothing
Set wbReturn = Nothing

End Sub

Sub callinProc()
Dim wkbDataWB As Workbook
Dim wksDataSheet As Worksheet
ObjectToWbSh fncDirectory("Base"), _
                          "My magic workbook.xlsm", _
                          "Data", _
                          wkbDataWB, _
                          wksDataSheet
'....
'code to work
'....
ObjectToNothing wkbDataWB, wksDataSheet

End Sub

fncDirectory("Base") is a function which returns the path to a given directory (as I'm working on different systems with different drives ad setups it's easier to have one function doing this job for all computers and files I use and exchange the module once any updates have been made).

Holger