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

[Nlhicks]

I am getting an error on the line RngRang01 = Range("A" & Rows.Count).End(xlUp).Row and then when I move it into a with block I get an error on the line Sheet1.Range("B2:B" & RngRange01).Font.Color = vbRed. I had this code running on the workbook that it lives in and it worked marvelously now my supervisor asked that I make it a stand alone macro workbook that I can use to change the saved/shared file. I am not sure what I need to do at this point to make it work. I was able to get some of the others to work but this one is causing issues.



Sub LineUpdate1()
'Last update 11/16/2022 by NLH
'Line Update Task List
'Compares what the user enters as Changes to what is in the existing spreadsheet.
'If there is a difference: The font color changes to red and the number is updated to match the user input. Otherwise if there is no change it keeps the original formatting and information.
'It then does the math to compute the difference between what was and what is now and defines it as uprate/downrate in a table to the right.
'Then it concatenates all of the values together to paste into an email and that is in a table down below.
'This module and the next 4 (Module 3,4,5,6,7) are all pretty much the same but each one is for a new change if more than one are made.
Application.ScreenUpdating = False

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


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

'Workbooks.Open Filename:="WAPA-UGPR Facility Rating and SOL Record (Test Workbook).xlsm"
Windows("WAPA-UGPR Facility Rating and SOL Record (Test Workbook).xlsm").Activate
Sheets("Facility Ratings & SOLs (Lines)").Activate

Set Sheet1 = Sheets("Facility Ratings & SOLs (Lines)")
Set Ws = Sheet1.UsedRange
With LineUpdate
'RngRang01 = Range("A" & Rows.Count).End(xlUp).Row
With Sheet1.Range("A1")
LineUpdate.Range("J13").Value = Sheet1.Range("A2:A685").SpecialCells(xlCellTypeVisible)

If LineUpdate.Range("C11") <> LineUpdate.Range("F11") And LineUpdate.Range("F11") <> "" Then
Sheet1.Range("B2:B" & RngRange01).Font.Color = vbRed
Sheet1.Range("B2:B" & RngRange01).Value = LineUpdate.Range("F11").Value
Else
If LineUpdate.Range("F11") = "" Then
Sheet1.Range("B2:B" & RngRange01).Value = Sheet1.Range("B2:B" & RngRange01).Value
End If
End If

If LineUpdate.Range("C12") <> LineUpdate.Range("F12") And LineUpdate.Range("F12") <> "" Then
Sheet1.Range("C2:C" & RngRange01).Font.Color = vbRed
Sheet1.Range("C2:C" & RngRange01).Value = LineUpdate.Range("F12").Value
Else

If LineUpdate.Range("F12") = "" Then
Sheet1.Range("C2:C" & RngRange01).Value = Sheet1.Range("C2:C" & RngRange01).Value

End If
End If


If LineUpdate.Range("C13") <> LineUpdate.Range("F13") And LineUpdate.Range("F13") <> "" Then
Sheet1.Range("D2:D" & RngRange01).Font.Color = vbRed
Sheet1.Range("D2:D" & RngRange01).Value = LineUpdate.Range("F13").Value
Else
If Worksheets("Line Update").Range("F13") = "" Then
Sheet1.Range("D2:D" & RngRange01).Value = Sheet1.Range("D2:D" & RngRange01).Value
End If
End If


If LineUpdate.Range("C14") <> LineUpdate.Range("F14") And LineUpdate.Range("F14") <> "" Then
Sheet1.Range("E2:E" & RngRange01).Font.Color = vbRed
Sheet1.Range("E2:E" & RngRange01).Value = Worksheets("Line Update").Range("F14").Value
Else
If LineUpdate.Range("F14") = "" Then
Sheet1.Range("E2:E" & RngRange01).Value = Sheet1.Range("E2:E").Value

End If
End If

If LineUpdate.Range("C15") <> LineUpdate.Range("F15") And LineUpdate.Range("F15") <> "" Then
Sheet1.Range("F2:F").Font.Color = vbRed
Sheet1.Range("F2:F" & RngRang01).Value = LineUpdate.Range("F15").Value
Else
If LineUpdate.Range("F15") = "" Then
Sheet1.Range("F2:F" & RngRang01).Value = Sheet1.Range("F2:F" & RngRang01).Value
End If
End If

If LineUpdate.Range("C16") <> LineUpdate.Range("F16") And LineUpdate.Range("F16") <> "" Then
Sheet1.Range("G2:G" & RngRang01).Font.Color = vbRed
Sheet1.Range("G2:G" & RngRang01).Value = WLineUpdate.Range("F16").Value
Else
If LineUpdate.Range("F16") = "" Then
Sheet1.Range("G2:G" & RngRang01).Value = Sheet1.Range("G2:G" & RngRang01).Value
End If
End If

If LineUpdate.Range("C17") <> LineUpdate.Range("F17") And LineUpdate.Range("F17") <> "" Then
Sheet1.Range("H2:H" & RngRang01).Font.Color = vbRed
Sheet1.Range("H2:H" & RngRang01).Value = LineUpdate.Range("F17").Value
Else
If LineUpdate.Range("F17") = "" Then
Sheet1.Range("H2:H" & RngRang01).Value = Sheet1.Range("H2:H" & RngRang01).Value
End If
End If

If LineUpdate.Range("C18") <> LineUpdate.Range("F18") And LineUpdate.Range("F18") <> "" Then
Sheet1.Range("I2:I" & RngRang01).Font.Color = vbRed
Sheet1.Range("I2:I" & RngRang01).Value = LineUpdate.Range("F18").Value
Else
If LineUpdate.Range("F18") = "" Then
Sheet1.Range("I2:I" & RngRang01).Value = Sheet1.Range("I2:I" & RngRang01).Value
End If
End If

'Worksheets("Line Update").Activate
End With
End With

Call LineColorCells

Call DoLineMath1
Application.ScreenUpdating = True

End Sub

 

[Nlhicks]

Need to figure out how to fix Line Update. I need it to take the values from the worksheet Line Update located in the Master workbook and update the proper cells in the sheet Facility Ratings & SOLs (Lines) located in WAPA-UGPR Facility Rating and SOL Record (Data File)_v161.xlsm. However, I wish to find the latest version rather than use the 161 since it will be updated everytime I save the workbook. We got this working on Find Right Row so I am pretty sure it will be a simple fix. I am trying to take the code written in Find Right Row and apply it to Line Update but I am getting this error message:

Any help to get it operational would be fantastic.



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.
Dim lngLastRow As Long
Dim wbFacility As Workbook
Dim wsUpdate As Worksheet
Dim wsFacility As Worksheet
Dim lngLooper As Long
Dim wb As Workbook
Dim strWbVersion

Const cstrPath As String = "C:\Users\nhicks\Documents\Ratings\Saved Versions\"
Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"
Const cstrShFacility As String = "Facility Ratings & SOLs (Lines)"
Const cstrwsUpdate As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
Const cstrUpdate As String = "Line Update"

strWbVersion = HighestVersion(cstrPath, ".xlsm", cstrWbFacility)
If Len(strWbVersion) = 0 Then
MsgBox "Could not spot a version of " & vbCrLf & cstrWbFacility & _
vbCrLf & "in Path" & cstrPath, vbInformation, cstrMsgTitle
GoTo end_here
End If
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, cstrMsgTitle
GoTo end_here
End If
End If
'///changed for workbook and worksheet
If Evaluate("ISREF('[" & cstrWbFacility & "]" & cstrUpdate & "'!A1)") Then
Set wsUpdate = wbFacility.Sheets(cstrUpdate)
Else
MsgBox "Sheet '" & cstrUpdate & "' not found in workbook '" & cstrWbFacility, vbInformation, "Ending here"
GoTo end_here
End If
'///changed for workbook and worksheet
If Evaluate("ISREF('[" & cstrWbFacility & "]" & cstrShFacility & "'!A1)") Then
Set wsFacility = wbFacility.Sheets(cstrShFacility)
Else
MsgBox "Sheet '" & cstrShFacility & "' not found in workbook '" & cstrWbFacility, vbInformation, cstrMsgTitle
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:
Set wsUpdate = Nothing
Set wsFacility = Nothing
Set wbFacility = Nothing
Application.ScreenUpdating = True

Exit Sub

err_handle:
MsgBox "Error occurred, refer to the Immediate Window for more information", vbInformation, "Sorry..."
Debug.Print Now
Debug.Print "Error Number: " & Err.Number
Debug.Print "Error Description: " & Err.Description
Err.Clear
On Error GoTo 0
Resume end_here

End Sub

 

[HaHoBe]

Hi Nlhicks,

please use [ CODE ] before and [ /CODE ] after (without blanks) for displaying codes here.

Your code looks like this:

For Each wb In Workbooks
If LCase(wb.Name) = LCase(cstrWbFacility) Then
Set wbFacility = wb
Exit For
End If
Next wb

Using code tags code looks like this

  For Each wb In Workbooks
    If LCase(wb.Name) = LCase(cstrWbFacility) Then
      Set wbFacility = wb
      Exit For
    End If
  Next wb

Please test the following modification:

Sub MrE_1223414_LineUpdate_mod02()
' 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
  Dim strWbVersion As String
  
  '//// adjust the path to match, this is my sample for testing \\\'
  Const cstrPath As String = "C:\Users\nhicks\Documents\Ratings\Saved Versions\"
  
  Const cstrStFileName As String = "WAPA-UGPR Facility Rating and SOL Record (Data File)_v"
  Const cstrUpdate As String = "Line Update"
  
  Const cstrWbFacility As String = "WAPA-UGPR Facility Rating and SOL Record (Master).xlsm"
  Const cstrShFacility As String = "Facility Ratings & SOLs (Lines)"

  Application.ScreenUpdating = False
  For Each wb In Workbooks
    If LCase(wb.Name) = LCase(cstrWbFacility) Then
      Set wbFacility = wb
      Exit For
    End If
  Next wb
  If wbFacility Is Nothing Then
    If Dir(cstrWbFacility) <> "" Then
      Set wbFacility = Workbooks.Open(cstrWbFacility)
    Else
      MsgBox "Could not find '" & cstrWbFacility & "' in current folder. Please open workbook and start again.", vbInformation, "Ending here"
      GoTo end_here
    End If
  End If
  '///changed for workbook and worksheet
  If Evaluate("ISREF('[" & cstrWbFacility & "]" & cstrUpdate & "'!A1)") Then
    Set wsUpdate = wbFacility.Sheets(cstrUpdate)
  Else
    MsgBox "Sheet '" & cstrUpdate & "' not found in workbook '" & cstrWbFacility, vbInformation, "Ending here"
    GoTo end_here
  End If
  
  '/// 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(strWbVersion) Then
      Set wbUpdate = wb
      Exit For
    End If
  Next wb
  If wbUpdate Is Nothing Then
    If Dir(IIf(Right(cstrPath, 1) = "\", cstrPath, cstrPath & "\") & strWbVersion) <> "" Then
      Set wbUpdate = Workbooks.Open(IIf(Right(cstrPath, 1) = "\", cstrPath, cstrPath & "\") & strWbVersion)
    Else
      MsgBox "Could not find '" & strWbVersion & "' in " & cstrPath & ". Please open workbook and start again.", vbInformation, cstrMsgTitle
      GoTo end_here
    End If
  End If
  '///changed for workbook and worksheet
  If Evaluate("ISREF('[" & strWbVersion & "]" & cstrShFacility & "'!A1)") Then
    Set wsFacility = wbUpdate.Sheets(cstrShFacility)
  Else
    MsgBox "Sheet '" & cstrShFacility & "' not found in workbook '" & strWbVersion, vbInformation, cstrMsgTitle
    GoTo end_here
  End If
  
  lngLastRow = wsUpdate.Range("A" & wsUpdate.Rows.Count).End(xlUp).Row
  
  With wsFacility
    wsUpdate.Range("J13").Value = .Range("A2:A685").SpecialCells(xlCellTypeVisible)
    For lngLooper = 11 To 18
      If wsUpdate.Cells(lngLooper, "C") <> wsUpdate.Cells(lngLooper, "F") And wsUpdate.Cells(lngLooper, "F") <> "" Then
        .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Font.Color = vbRed
        .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Value = wsUpdate.Cells(lngLooper, "F").Value
      Else
        If wsUpdate.Cells(lngLooper, "F") = "" Then
          .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Value = _
              .Range(.Cells(2, lngLooper - 9), .Cells(lngLastRow, lngLooper - 9)).Value
        End If
      End If
    Next lngLooper
  End With
  
'  Call LineColorCells   'unable to test
'
'  Call DoLineMath1      'unable to test

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

err_handle:
  MsgBox "Error occurred, refer to the Immediate Window for more information", vbInformation, "Sorry..."
  Debug.Print Now
  Debug.Print "Error Number: " & Err.Number
  Debug.Print "Error Description: " & Err.Description
  Err.Clear
  On Error GoTo 0
  Resume end_here

End Sub

Ciao,
Holger

 

[Nlhicks]

Compile error: Variable not defined at Set wbUpdate = wb

 

[Nlhicks]

I added Dim wbUpdate as Workbook and the error went away

 

[Nlhicks]

Okay so the code kind of worked: After I find the right row, when I run Line Update it is updating the header line instead of the line where I need the data updated. Here is a snapshot of what the code did versus what it should do.

 

[Nlhicks]

The header should stay like this

 

[HaHoBe]

Hi Nlhicks,

this should be the codeline causing the trouble:

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

Depending on how many rows are filled this line will get the last filled row. If no data is found in the given column the line of the header would be taken as reference (meaning lngLastRow will be 1 covering the range for Row 1 and Row 2). So is it correct to search "Line Update" for the last row? A small adjustment should help

  lngLastRow = WorksheetFunction.Max(wsUpdate.Range("A" & wsUpdate.Rows.Count).End(xlUp).Row, 2)

as this would apply the code only starting on Row 2.

Ciao,
Holger

 

[Nlhicks]

I put in lngLastRow = WorksheetFunction.Max(wsUpdate.Range("A" & wsUpdate.Rows.Count).End(xlUp).Row, 2) where you you suggested I put it in and now nothing is happening.

 

[Nlhicks]

Maybe we need a combination of the previous code and the new code what are your thoughts

 

[HaHoBe]

Hi Nlhicks,

rewrite what code to what new code and which parts to take and what to change? Please keep in mind that all I have is the code supplied here. Without seeing what happens where (or better what should be done where) I sadly decided to start all over again. And here we start with a question for your procedure DoLineMath1 (which happens to be the first I worked on): could you please refer to the comments posted in the code part and explain why the contents of different cells should be written into the same target cells? And what about the check for empty cells?

    '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
        'for 0 Checked Addresses C11 and F11, Target L13
        'for 1 Checked Addresses C11 and F11, Target L13
        '/// identical cells abd both target for the same cell???
        If .Cells(11, "C").Value <> .Cells(11, "F").Value Then
          .Cells(13, "L").Value = .Cells(11, "F") - .Cells(11, "C")
        End If
        'for 0 Checked Addresses C13 and F13, Target M13
        'for 1 Checked Addresses C14 and F14, Target M13
        '/// both target for 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
        'for 0 Checked Addresses C15 and F15, Target O13
        'for 1 Checked Addresses C16 and F16, Target O13
        '/// both target for the same cell???
        If .Cells(15 + i, "C").Value <> .Cells(15 + i, "F").Value Then
          .Cells(13, "O").Value = .Cells(15, "F") - .Cells(15, "C")
        End If
        'for 0 Checked Addresses C17 and F17, Target P13
        'for 1 Checked Addresses C18 and F18, Target P13
        '/// both target for the same cell???
        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

Holger