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

Nlhicks

Nlhicks

Board Regular
Joined
Jan 8, 2021
Messages
244
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
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
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.

VBA 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
 
Upvote 1
Hi NlHicks,

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

According to the Dims it should be

Rich (BB code): 
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
VBA Code: 
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
 
Upvote 1
Thank you so much I will work on this and see if it works, I am pretty sure it looks like it will:)
 
Upvote 0
I turned on Option explicit. Also, here is my color cells and do math, maybe you can look at them and make sure that they will work with the code you have above. They work as they are but maybe some magic dust you create can help make them shine.


Sub LineColorCells()

Dim LR As Long
Dim Sheet2 As Worksheet

Workbooks.Open Filename:="WAPA-UGPR Facility Rating and SOL Record (Data File)_v159.xlsx"
Windows("WAPA-UGPR Facility Rating and SOL Record (Data File)_v159.xlsx").Activate
Sheets("Facility Ratings & SOLs (Lines)").Activate
LR = Range("B" & Rows.Count).End(xlUp).Row
Range("A2:N" & LR).SpecialCells(xlCellTypeVisible).Select

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ColorIndex = 34
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Worksheets("Line Update").Activate
End Sub

Sub DoLineMath1()

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

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

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


Call Line_Bold_in_Concatenate1

End Sub


Public Sub Line_Bold_in_Concatenate1()

Dim GN As String, FN As String, HN As String, KN As String, LN As String, MN As String, NN As String
FN = Worksheets("Line Update").Range("L11")
GN = Worksheets("Line Update").Range("O11")
HN = Worksheets("Line Update").Range("K13")
KN = Worksheets("Line Update").Range("N13")
LN = Worksheets("Line Update").Range("L13")
MN = Worksheets("Line Update").Range("O13")
NN = Worksheets("Line Update").Range("Q13")

Range("C32").Value = ("(" & FN & " " & HN & " " & LN & " " & NN & " " & "," & " " & GN & " " & KN & " " & MN & " " & NN & ")")
Range("C32").Font.Bold = True

End Sub
 
Upvote 0
Can you also look at the Find Right Row? It works but I am getting an error on the activated workbooks so if you have a work around on that it would be great. Thank you

Sub FindRightRow1()

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

Application.ScreenUpdating = False

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

Windows("WAPA-UGPR Facility Rating and SOL Record(Test Workbook).xlsm").Activate
Sheets("Facility Ratings & SOLs (Lines)").Activate
Set Sheet2 = Sheets("Facility Ratings & SOLs (Lines)")
Set Ws = Sheet2.UsedRange

With Sheet2.Range("A1")
If LineUpdate.Range("D5").Value <> "" Then
Sheets("Facility Ratings & SOLs (Lines)").Activate
.AutoFilter field:=10, Criteria1:="*" & LineUpdate.Range("D5") & "*"
End If
If LineUpdate.Range("D6").Value <> "" Then
.AutoFilter field:=11, Criteria1:="*" & LineUpdate.Range("D6") & "*"
End If
If LineUpdate.Range("D7").Value <> "" Then
.AutoFilter field:=37, Criteria1:="" & LineUpdate.Range("D7") & ""
End If

Rowz = Application.WorksheetFunction.Subtotal(3, Range("A2:A686" & Rows(Rows.Count).End(xlUp).Row))
Debug.Print Rowz
'
'With Ws
If Rowz <= 1 Then

LineUpdate.Range("C11").Value = Sheet2.Range("B2:B695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C12").Value = Sheet2.Range("C2:C695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C13").Value = Sheet2.Range("D2:D695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C14").Value = Sheet2.Range("E2:E695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C15").Value = Sheet2.Range("F2:F695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C16").Value = Sheet2.Range("G2:G695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C17").Value = Sheet2.Range("H2:H695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C18").Value = Sheet2.Range("I2:I695").SpecialCells(xlCellTypeVisible)

GoTo Skip

ElseIf Rowz > 1 Then GoSub Item_Open
Sheets("Facility Ratings & SOLs (Lines)").Activate
.AutoFilter field:=36, Criteria1:=LineUpdate.Range("H6")

LineUpdate.Range("C11").Value = Sheet2.Range("B2:B695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C12").Value = Sheet2.Range("C2:C695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C13").Value = Sheet2.Range("D2:D695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C14").Value = Sheet2.Range("E2:E695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C15").Value = Sheet2.Range("F2:F695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C16").Value = Sheet2.Range("G2:G695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C17").Value = Sheet2.Range("H2:H695").SpecialCells(xlCellTypeVisible)
LineUpdate.Range("C18").Value = Sheet2.Range("I2:I695").SpecialCells(xlCellTypeVisible)

Skip:
End If

End With

Exit Sub

Item_Open:

Dim sValue As String

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

sValue = Application.InputBox("Enter the TO: Bus Number here, Thank you.")
Worksheets("Line Update").Range("H6").Value = sValue
Debug.Print sValue
Return

'End With

Application.ScreenUpdating = True

End Sub
 
Upvote 0
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?
VBA Code: 
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
 
Upvote 1
Hi NlHicks,

code from above, some additional checks added:

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

VBA Code: 
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
 
Upvote 1
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
 
Upvote 1
HaHoBe said:
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?
VBA Code: 
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
Click to expand...
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

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

Forum statistics

Threads
1,214,869
Messages
6,122,012
Members
449,060
Latest member
LinusJE

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