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

Nlhicks

Nlhicks

Active Member
Joined
Jan 8, 2021
Messages
264
Office Version
  1. 365
Platform
  1. Windows
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
 
Sort by date Sort by votes
Nlhicks said:
The result is stored in Line Update so even when changing the code for another workbook this piece of the code should not be affected since it is in the macro workbook. 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.
Click to expand...
Hi Ha,
I actually know how to use L2BB and upload my code unfortunately it is an add-in and I cannot use it on my work computer. I can use it on my home computer so if it would be preferred I can send this to my home and the use my home computer to upload it. It is just kind of a pain but I will if you would like it.
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
HaHoBe said:
I can't figure out where the range C32 is located:

VBA Code: 
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:

VBA Code: 
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:

VBA Code: 
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,
HaHoBe said:
I can't figure out where the range C32 is located:

VBA Code: 
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:

VBA Code: 
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:

VBA Code: 
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
Click to expand...
Hi Holger, the only issue I can see with this is that the sheet Facility Rating and SOL Record (Lines) is not in my (Master) workbook it is in WAPA-UGPR Facility Rating and SOL Record (Data File)_v161.xlsm. How can I make it reference the right workbook?
Click to expand...
 
Upvote 0
1669844395872.png
 
Upvote 0
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. Also, when I save this workbook after updates are made it will become v162 so I need to figure out how to coordinate the code to operate on the latest version since it is always changing.
 
Upvote 0
Nlhicks said:
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. Also, when I save this workbook after updates are made it will become v162 so I need to figure out how to coordinate the code to operate on the latest version since it is always changing.
Click to expand...
I need to find the right row in the v161 file and then extract the values from that into Line Update. Right now I am getting an error saying that Line Update is not found it v162 and that is correct it is not in v162 it is in the master file.
 
Upvote 0
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.
Click to expand...

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.
Click to expand...

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
 
Upvote 1
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:

VBA Code: 
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:

VBA Code: 
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
 
Upvote 1
I am getting an error of Path not found on the line Set objFolder=objFSO.GetFolder(FolderName) in the function which stops the macro from running.
 
Upvote 0
Hi Nlhicks,

change the function to
VBA Code: 
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

VBA Code: 
 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
 
Upvote 1
You must log in or register to reply here.

Similar threads

Nlhicks
  • Locked
  • Question Question
Apply code to latest version
Replies
1
Views
484
Fluff
Fluff
Nlhicks
  • Solved
Make Code work from Splash Page "Line Update"
2
Replies
19
Views
830
Fluff
Fluff
Nlhicks
  • Solved
One line getting half a line that is blue and the other not getting blue at all
Replies
1
Views
419
Legacy 143009
L
U
  • Question Question
Seeking Help with CELLS Property in VBA
2
Replies
13
Views
631
Alex Blakenburg
A
Nlhicks
  • Question Question
Application-defined or object-defined error
Replies
4
Views
661
Nlhicks
Nlhicks

Forum statistics

Threads
1,223,911
Messages
6,175,327
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top