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
 
Sort by date Sort by votes
Hi Nlhicks,

glad to finally deliver a working set of codes.

If you could be satisfied with just filling the background for Columns B to I (merging code from MrE_1223414_1615014_LineColorCells_New at least partly) and using a dimmed variable:
VBA Code: 
Const cstrMsgTitle As String = "Ending LineUpdate"
'

Sub MrE_1223414_1615014_LineUpdate_New221205_mod2()
' https://www.mrexcel.com/board/threads/run-my-master-workbook-and-call-another-non-macro-enabled-workbook-and-do-the-edits-to-it-prior-to-saving.1223414/
'Last update 11/16/2022 by NLH
'Line Update Task List
'Compares what the user enters as Changes to what is in the existing spreadsheet.
'If there is a difference: The font color changes to red and the number is updated to match the user input. Otherwise if there is no change it keeps the original formatting and information.
'It then does the math to compute the difference between what was and what is now and defines it as uprate/downrate in a table to the right.
'Then it concatenates all of the values together to paste into an email and that is in a table down below.
'This module and the next 4 (Module 3,4,5,6,7) are all pretty much the same but each one is for a new change if more than one are made.
' Updated: 20221205
'
  Dim blnEnd            As Boolean
  Dim lngLastRow        As Long
  Dim lngLooper         As Long
  Dim strWbVersion      As String
  Dim wbkData           As Workbook
  Dim wksFrom           As Worksheet
  Dim wbkTarget         As Workbook
  Dim wksWorkOn         As Worksheet

  Const cstrPath        As String = "C:\Users\nhicks\Documents\Ratings\Saved Versions\"
  Const cstrWbData      As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
  Const cstrShData      As String = "Line Update"

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

  If wbkData Is Nothing Then
    MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  If wksFrom Is Nothing Then
    MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  
  '/// will find any xls, xlsb, xlsx or xlsm workbook that start with cstrStFileName
  '/// and should deliver the highest number from there
  strWbVersion = HighestVersion(cstrPath, ".xlsm", cstrStFileName)
  If Len(strWbVersion) = 0 Then
    MsgBox "Could not spot a version of " & vbCrLf & cstrStFileName & _
        vbCrLf & "in Path " & cstrPath, vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  
  GetWorkbook_Worksheet cstrPath, strWbVersion, wbkTarget, cstrShFacility, wksWorkOn

  If wbkTarget Is Nothing Then
    MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  If wksWorkOn Is Nothing Then
    MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  
  With wksWorkOn
    lngLastRow = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1).Row
    wksFrom.Range("J13").Value = .Range("A2:A685").SpecialCells(xlCellTypeVisible).Cells.Count
    For lngLooper = 11 To 18
      With .Cells(lngLastRow, lngLooper - 9)
        If wksFrom.Cells(lngLooper, "C") <> wksFrom.Cells(lngLooper, "F") And wksFrom.Cells(lngLooper, "F") <> "" Then
          .Font.Color = vbRed
          With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ColorIndex = 34
            .TintAndShade = 0
            .PatternTintAndShade = 0
          End With
          .Value = wksFrom.Cells(lngLooper, "F").Value
        Else
          If wksFrom.Cells(lngLooper, "F") = "" Then
            .Value = .Value
          End If
        End If
      End With
    Next lngLooper
  End With
  
'  Call DoLineMath1      'commented out for test

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

End Sub

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

VBA Code: 
Const cstrMsgTitle As String = "Ending LineUpdate"
'

Sub MrE_1223414_1615014_LineUpdate_New221205_mod3()
' https://www.mrexcel.com/board/threads/run-my-master-workbook-and-call-another-non-macro-enabled-workbook-and-do-the-edits-to-it-prior-to-saving.1223414/
'Last update 11/16/2022 by NLH
'Line Update Task List
'Compares what the user enters as Changes to what is in the existing spreadsheet.
'If there is a difference: The font color changes to red and the number is updated to match the user input. Otherwise if there is no change it keeps the original formatting and information.
'It then does the math to compute the difference between what was and what is now and defines it as uprate/downrate in a table to the right.
'Then it concatenates all of the values together to paste into an email and that is in a table down below.
'This module and the next 4 (Module 3,4,5,6,7) are all pretty much the same but each one is for a new change if more than one are made.
' Updated: 20221205
'
  Dim blnEnd            As Boolean
  Dim blnColour         As Boolean
  Dim lngLastRow        As Long
  Dim lngLooper         As Long
  Dim strWbVersion      As String
  Dim wbkData           As Workbook
  Dim wksFrom           As Worksheet
  Dim wbkTarget         As Workbook
  Dim wksWorkOn         As Worksheet

  Const cstrPath        As String = "C:\Users\nhicks\Documents\Ratings\Saved Versions\"
  Const cstrWbData      As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
  Const cstrShData      As String = "Line Update"

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

  If wbkData Is Nothing Then
    MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  If wksFrom Is Nothing Then
    MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  
  '/// will find any xls, xlsb, xlsx or xlsm workbook that start with cstrStFileName
  '/// and should deliver the highest number from there
  strWbVersion = HighestVersion(cstrPath, ".xlsm", cstrStFileName)
  If Len(strWbVersion) = 0 Then
    MsgBox "Could not spot a version of " & vbCrLf & cstrStFileName & _
        vbCrLf & "in Path " & cstrPath, vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  
  GetWorkbook_Worksheet cstrPath, strWbVersion, wbkTarget, cstrShFacility, wksWorkOn

  If wbkTarget Is Nothing Then
    MsgBox "No Object set for '" & cstrWbData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  If wksWorkOn Is Nothing Then
    MsgBox "No Object set for '" & cstrShData & "'. ", vbInformation, cstrMsgTitle
    blnEnd = True
    GoTo end_here
  End If
  
  blnColour = False
  
  With wksWorkOn
    lngLastRow = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1).Row
    wksFrom.Range("J13").Value = .Range("A2:A685").SpecialCells(xlCellTypeVisible).Cells.Count
    For lngLooper = 11 To 18
      With .Cells(lngLastRow, lngLooper - 9)
        If wksFrom.Cells(lngLooper, "C") <> wksFrom.Cells(lngLooper, "F") And wksFrom.Cells(lngLooper, "F") <> "" Then
          .Font.Color = vbRed
          .Value = wksFrom.Cells(lngLooper, "F").Value
          blnColour = True
        Else
          If wksFrom.Cells(lngLooper, "F") = "" Then
            .Value = .Value
          End If
        End If
      End With
    Next lngLooper
    If blnColour Then
      With .Range("A" & lngLastRow & ":N" & lngLastRow).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 34
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
    End If
  End With
  
'  Call DoLineMath1      'commented out for test

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

End Sub

Holger
 
Upvote 1
MrE_1223414_1615014_LineUpdate_New221205_mod3 will colour Columns A to N on any change of font color and a new value to the cells watched. If you want the colour to be applied in any case change

VBA Code: 
    If blnColour Then
      With .Range("A" & lngLastRow & ":N" & lngLastRow).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 34
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
    End If

to

VBA Code: 
'    If blnColour Then
      With .Range("A" & lngLastRow & ":N" & lngLastRow).Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 34
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
'    End If

Holger
 
Upvote 1
Hi Nlhicks,

really?

From the opening post (shortened):
Rich (BB code): 
Sub LineUpdate1()
   Dim RngRange01 As Range
 '...
       Windows("WAPA-UGPR Facility Rating and SOL Record (Master).xlsm").Activate
       Sheets("Line Update").Activate
       Set LineUpdate = Sheets("Line Update")
'...
    With LineUpdate
    'RngRang01 = Range("A" & Rows.Count).End(xlUp).Row
From just some time ago:
Rich (BB code): 
Sub XfrmUpdate3()
   Dim RngRange01 As Range
       Application.ScreenUpdating = False
   Worksheets("Facility Ratings & SOLs (Xfmrs)").Activate
       RngRang01 = Range("A" & Rows.Count).End(xlUp).Row

The opening post of this thread as well as the errors for the code have been fixed, and I think I did a bit more than what should be expected when trying to fix other codes as well (which were not part of the starting post).

Holger
 
Upvote 1
Okay, one more.

I can see that you transfered the code and changed the constants as well as the rows on which to work.

Original code looked like
VBA Code: 
    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
As this was only the first part of some more lines handling the next rows the code was changed to use a loop instead
VBA Code: 
    For lngLooper = 11 To 18
      'column number at start is 11 (K), wanted is 2(B), so adjust by - 9
      With .Cells(lngLastRow, lngLooper - 9)
        If wksFrom.Cells(lngLooper, "C") <> wksFrom.Cells(lngLooper, "F") And wksFrom.Cells(lngLooper, "F") <> "" Then
          .Font.Color = vbRed
          '...

The new original code looks like this in the relevant part:
VBA Code: 
If Worksheets("Xfmr Update").Range("C8") <> Worksheets("Xfmr Update").Range("D8") And Worksheets("Xfmr Update").Range("D8") <> "" Then
  Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("C2:C" & RngRang01).Font.Color = vbRed
  Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("C2:C" & RngRang01).Value = Worksheets("Xfmr Update").Range("D8").Value
Else
You changed it to read like
Rich (BB code): 
For lngLooper = 8 To 23
With .Cells(lngLastRow, lngLooper - 9)
which would result in a column number of -1 where only number between 1 and 16384 are allowed spanning from A to XFD.

I believe it to be easier to add another variable lngColumn and work with that like
VBA Code: 
lngColumn = 3   'representing column number 3 (C), will get augmented before the next row number
For lngLooper = 8 To 23
  With .Cells(lngLastRow, lngColumn)
    If wksFrom.Cells(lngLooper, "C") <> wksFrom.Cells(lngLooper, "D") And wksFrom.Cells(lngLooper, "D") <> "" Then
      .Font.Color = vbRed
      With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ColorIndex = 34
        .TintAndShade = 0
        .PatternTintAndShade = 0
      End With
      .Value = wksFrom.Cells(lngLooper, "D").Value
      Else
      If wksFrom.Cells(lngLooper, "D") = "" Then
        .Value = .Value
      End If
    End If
  End With
  lngColumn = lngColumn + 1
Next lngLooper
instead of counting out how many columns to the left of the starting column for the row number you should go.
 
Upvote 1
Solution
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
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
382
Fluff
Fluff
Nlhicks
  • Solved
Make Code work from Splash Page "Line Update"
2
Replies
19
Views
656
Fluff
Fluff
Nlhicks
  • Solved
One line getting half a line that is blue and the other not getting blue at all
Replies
1
Views
337
Legacy 143009
L
U
  • Question
Seeking Help with CELLS Property in VBA
2
Replies
13
Views
307
Alex Blakenburg
A
Nlhicks
  • Question
Application-defined or object-defined error
Replies
4
Views
542
Nlhicks
Nlhicks

Forum statistics

Threads
1,215,986
Messages
6,128,118
Members
449,423
Latest member
Mike_AL

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