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
I thought yesterday we got the whole row to highlight but today only the cells that got changed have highlight. Can it be changed so that the entire row gets highlighted?


1670338018901.png
 
Upvote 0

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
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
What do you think about helping with the transformer code: I tried changing the one for Lines to work with Xfmrs but there are a couple of subtle differences. First I will share my original code that worked perfectly when there was only one workbook:


Sub XfrmUpdate3()
Dim RngRange01 As Range
Application.ScreenUpdating = False
Worksheets("Facility Ratings & SOLs (Xfmrs)").Activate
RngRang01 = Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Xfmr Update").Range("K15").Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("A2:A685").SpecialCells(xlCellTypeVisible)
Worksheets("Xfmr Update").Range("L15").Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("B2:B685").SpecialCells(xlCellTypeVisible)
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
If Worksheets("Xfmr Update").Range("D8") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("C2:C" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("C2:C" & RngRang01).Value

End If
End If

If Worksheets("Xfmr Update").Range("C9") <> Worksheets("Xfmr Update").Range("D9") And Worksheets("Xfmr Update").Range("D9") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("D2:D" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("D2:D" & RngRang01).Value = Worksheets("Xfmr Update").Range("D9").Value
Else

If Worksheets("Xfmr Update").Range("D9") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("D2:D" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("D2:D" & RngRang01).Value

End If
End If

If Worksheets("Xfmr Update").Range("C10") <> Worksheets("Xfmr Update").Range("D10") And Worksheets("Xfmr Update").Range("D10") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("E2:E" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("E2:E" & RngRang01).Value = Worksheets("Xfmr Update").Range("D10").Value
Else
If Worksheets("Xfmr Update").Range("D10") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("E2:E" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("E2:E" & RngRang01).Value

End If
End If

If Worksheets("Xfmr Update").Range("C11") <> Worksheets("Xfmr Update").Range("D11") And Worksheets("Xfmr Update").Range("D11") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("F2:F" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("F2:F" & RngRang01).Value = Worksheets("Xfmr Update").Range("D11").Value
Else

If Worksheets("Xfmr Update").Range("D11") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("F2:F" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("F2:F" & RngRang01).Value
End If
End If

If Worksheets("Xfmr Update").Range("C12") <> Worksheets("Xfmr Update").Range("D12") And Worksheets("Xfmr Update").Range("D12") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("G2:G" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("G2:G" & RngRang01).Value = Worksheets("Xfmr Update").Range("D12").Value
Else
If Worksheets("Xfmr Update").Range("D12") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("G2:G" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("G2:G" & RngRang01).Value
End If
End If

If Worksheets("Xfmr Update").Range("C13") <> Worksheets("Xfmr Update").Range("D13") And Worksheets("Xfmr Update").Range("D13") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("H2:H" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("H2:H" & RngRang01).Value = Worksheets("Xfmr Update").Range("D13").Value
Else
If Worksheets("Xfmr Update").Range("D13") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("H2:H" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("H2:H" & RngRang01).Value
End If
End If

If Worksheets("Xfmr Update").Range("C14") <> Worksheets("Xfmr Update").Range("D14") And Worksheets("Xfmr Update").Range("D14") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("I2:I" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("I2:I" & RngRang01).Value = Worksheets("Xfmr Update").Range("D14").Value
Else
If Worksheets("Xfmr Update").Range("D14") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("I2:I" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("I2:I" & RngRang01).Value
End If
End If


If Worksheets("Xfmr Update").Range("C15") <> Worksheets("Xfmr Update").Range("D15") And Worksheets("Xfmr Update").Range("D15") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("J2:J" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("J2:J" & RngRang01).Value = Worksheets("Xfmr Update").Range("D15").Value
Else
If Worksheets("Xfmr Update").Range("D15") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("J2:J" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("J2:J" & RngRang01).Value

End If
End If

If Worksheets("Xfmr Update").Range("C16") <> Worksheets("Xfmr Update").Range("D16") And Worksheets("Xfmr Update").Range("D16") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("K2:K" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("K2:K" & RngRang01).Value = Worksheets("Xfmr Update").Range("D16").Value
Else
If Worksheets("Xfmr Update").Range("D16") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("K2:K" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("K2:K" & RngRang01).Value
End If
End If

If Worksheets("Xfmr Update").Range("C17") <> Worksheets("Xfmr Update").Range("D17") And Worksheets("Xfmr Update").Range("D17") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("L2:L" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("L2:L" & RngRang01).Value = Worksheets("Xfmr Update").Range("D17").Value
Else
If Worksheets("Xfmr Update").Range("D17") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("L2:L" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("L2:L" & RngRang01).Value

End If
End If

If Worksheets("Xfmr Update").Range("C18") <> Worksheets("Xfmr Update").Range("D18") And Worksheets("Xfmr Update").Range("D18") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("M2:M" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("M2:M" & RngRang01).Value = Worksheets("Xfmr Update").Range("D18").Value
Else
If Worksheets("Xfmr Update").Range("D18") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("M2:M" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("M2:M" & RngRang01).Value
End If
End If


If Worksheets("Xfmr Update").Range("C19") <> Worksheets("Xfmr Update").Range("D19") And Worksheets("Xfmr Update").Range("D19") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("N2:N" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("N2:N" & RngRang01).Value = Worksheets("Xfmr Update").Range("D19").Value
Else
If Worksheets("Xfmr Update").Range("D19") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("N2:N" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("N2:N" & RngRang01).Value
End If
End If

If Worksheets("Xfmr Update").Range("C20") <> Worksheets("Xfmr Update").Range("D20") And Worksheets("Xfmr Update").Range("D20") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("O2:O" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("O2:O" & RngRang01).Value = Worksheets("Xfmr Update").Range("D20").Value
Else
If Worksheets("Xfmr Update").Range("D20") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("O2:O" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("O2:O" & RngRang01).Value
End If
End If

If Worksheets("Xfmr Update").Range("C21") <> Worksheets("Xfmr Update").Range("D21") And Worksheets("Xfmr Update").Range("D21") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("P2:P" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("P2:P" & RngRang01).Value = Worksheets("Xfmr Update").Range("D21").Value
Else
If Worksheets("Xfmr Update").Range("D21") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("P2:P" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("P2:P" & RngRang01).Value
End If
End If

If Worksheets("Xfmr Update").Range("C22") <> Worksheets("Xfmr Update").Range("D22") And Worksheets("Xfmr Update").Range("D22") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("Q2:Q" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("Q2:Q" & RngRang01).Value = Worksheets("Xfmr Update").Range("D22").Value
Else
If Worksheets("Xfmr Update").Range("D22") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("Q2:Q" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("Q2:Q" & RngRang01).Value

End If
End If

If Worksheets("Xfmr Update").Range("C23") <> Worksheets("Xfmr Update").Range("D23") And Worksheets("Xfmr Update").Range("D23") <> "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("R2:R" & RngRang01).Font.Color = vbRed
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("R2:R" & RngRang01).Value = Worksheets("Xfmr Update").Range("D23").Value
Else
If Worksheets("Xfmr Update").Range("D23") = "" Then
Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("R2:R" & RngRang01).Value = Worksheets("Facility Ratings & SOLs (Xfmrs)").Range("R2:R" & RngRang01).Value
End If
End If

Call ApplyColor
Call DoXfmrMath3
Worksheets("Xfmr Update").Activate

Application.ScreenUpdating = True
End Sub

Sub DoXfmrMath3()

Dim Ws As Worksheet
Dim i As Long


Set Ws = Sheets("Xfmr Update")

If Ws.Range("D8, D10, D12, D14, D16, D20, D22") = "" Then
Ws.Range("O11, O12,P11,P12,R11, R12,S11,S12") = ""

Else

For i = 0 To 1
If Ws.Cells(8 + (i * 4), "C").Value <> Ws.Cells(8 + (i * 4), "D").Value Then
Ws.Cells(15 + i, "O").Value = Ws.Cells(8 + (i * 4), "D") - Ws.Cells(8 + (i * 4), "C")
End If

If Ws.Cells(10 + (i * 4), "C").Value <> Ws.Cells(10 + (i * 4), "D").Value Then
Ws.Cells(15 + i, "P").Value = Ws.Cells(10 + (i * 4), "D") - Ws.Cells(10 + (i * 4), "C")
End If

If Ws.Cells(16 + (i * 4), "C").Value <> Ws.Cells(16 + (i * 4), "D").Value Then
Ws.Cells(15 + i, "R").Value = Ws.Cells(16 + (i * 4), "D") - Ws.Cells(16 + (i * 4), "C")

End If
If Ws.Cells(18 + (i * 4), "C").Value <> Ws.Cells(18 + (i * 4), "D").Value Then
Ws.Cells(15 + i, "S").Value = Ws.Cells(18 + (i * 4), "D") - Ws.Cells(18 + (i * 4), "C")
End If

Next i
End If

Call Xfmr_Bold_in_Concatenate3

End Sub
Public Sub Xfmr_Bold_in_Concatenate3()

Dim GN As String, FN As String, HN As String, KN As String, LN As String, MN As String, NN As String, PN As String

EN = Worksheets("Xfmr Update").Range("M13")
FN = Worksheets("Xfmr Update").Range("M14")
GN = Worksheets("Xfmr Update").Range("O9")
HN = Worksheets("Xfmr Update").Range("R9")
JN = Worksheets("Xfmr Update").Range("N13")
KN = Worksheets("Xfmr Update").Range("M13")
LN = Worksheets("Xfmr Update").Range("O13")
MN = Worksheets("Xfmr Update").Range("S13")

EM = Worksheets("Xfmr Update").Range("N14")
FM = Worksheets("Xfmr Update").Range("M14")
GM = Worksheets("Xfmr Update").Range("O14")
HM = Worksheets("Xfmr Update").Range("P14")
JM = Worksheets("Xfmr Update").Range("R14")
KM = Worksheets("Xfmr Update").Range("Q14")

Range("C36").Value = ("(" & EN & " : " & " " & GN & " " & JN & " " & LN & " " & "MVA" & "," & " " & HN & " " & LN & " " & "MVA" & ")")
Range("C36").Font.Bold = True
Range("C37").Value = ("(" & FN & " : " & " " & GN & " " & EM & " " & GM & " " & "MVA" & "," & " " & HN & " " & " " & KM & " " & JM & " " & "MVA" & ")")
Range("C37").Font.Bold = True

End Sub
 
Upvote 0
Here is the line update code that I am trying to rewrite for the transformer page. Next I will provide a snapshot of the xfmr page and the Xfmr Update page



Const cstrMsgTitle As String = "Ending XfmrUpdate"
'

Sub XfmrUpdate1()
' Run my master workbook and call another non-macro enabled workbook and do the edits to it prior to saving
'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 (Xfmrs)"

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("K11").Value = .Range("A2:A685").SpecialCells(xlCellTypeVisible).Cells.Value
For lngLooper = 8 To 23
With .Cells(lngLastRow, lngLooper - 9)
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
Next lngLooper
End With

Call DoXfmrMath1 'commented out for test

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

End Sub
Sub GetWorkbook_Worksheet(sPath As String, _
sWbName As String, _
wbkToSet As Object, _
sShName As String, _
wksToSet As Object)

'Parameters passed:
' sPath: Drive and Path to the Folder for workbook
' sWbName: Name and Extension of workbook
' wbkToSet: Empty Object to the workbook which should be filled withing
' sShName: Name of worksheet in workbook
' wksToSet: Empty Object to the worksheet which should be filled withing

Dim Wb As Workbook 'object to loop through the open workbooks in the instance
Dim blnNew As Boolean 'to detect whether workbook is opend (active one by default then) or
'was open (so must not be active one) deciding how to check for the sheetname

blnNew = False

If Len(sWbName) = 0 Then GoTo end_GetWbkWks
For Each Wb In Workbooks
If LCase(Wb.Name) = LCase(sWbName) Then
Set wbkToSet = Wb
Exit For
End If
Next Wb

If wbkToSet Is Nothing Then
If Right(sPath, 1) <> Application.PathSeparator Then sPath = sPath & Application.PathSeparator
If Dir(sPath, vbDirectory) = "" Then GoTo end_GetWbkWks
If Dir(sPath & sWbName) <> "" Then
Set wbkToSet = Workbooks.Open(sPath & sWbName)
blnNew = True
Else
GoTo end_GetWbkWks
End If
End If

If Len(sShName) = 0 Then GoTo end_GetWbkWks
If blnNew Then
If Evaluate("ISREF('" & sShName & "'!A1)") Then
Set wksToSet = wbkToSet.Sheets(sShName)
End If
Else
If Evaluate("ISREF('[" & sWbName & "]" & sShName & "'!A1)") Then
Set wksToSet = wbkToSet.Sheets(sShName)
End If
End If
end_GetWbkWks:

End Sub

Sub Workbook_Worksheet2Nothing(wbkToSet As Object, wksToSet As Object)

Set wksToSet = Nothing
Set wbkToSet = Nothing

End Sub
Function HighestVersion(FolderName As String, _
Ext As String, _
StartFileName As String) As String
' Run my master workbook and call another non-macro enabled workbook and do the edits to it prior to saving
' adapted from: Find the latest version

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

Sub DoXfmrMath1()

Dim Ws As Worksheet
Dim i As Long


Set Ws = Sheets("Xfmr Update")

If Ws.Range("D8, D10, D12, D14, D16, D20, D22") = "" Then
Ws.Range("O11, O12,P11,P12,R11, R12,S11,S12") = ""

Else

For i = 0 To 1
If Ws.Cells(8 + (i * 4), "C").Value <> Ws.Cells(8 + (i * 4), "D").Value Then
Ws.Cells(11 + i, "O").Value = Ws.Cells(8 + (i * 4), "D") - Ws.Cells(8 + (i * 4), "C")
End If

If Ws.Cells(10 + (i * 4), "C").Value <> Ws.Cells(10 + (i * 4), "D").Value Then
Ws.Cells(11 + i, "P").Value = Ws.Cells(10 + (i * 4), "D") - Ws.Cells(10 + (i * 4), "C")
End If

If Ws.Cells(16 + (i * 4), "C").Value <> Ws.Cells(16 + (i * 4), "D").Value Then
Ws.Cells(11 + i, "R").Value = Ws.Cells(16 + (i * 4), "D") - Ws.Cells(16 + (i * 4), "C")

End If
If Ws.Cells(18 + (i * 4), "C").Value <> Ws.Cells(18 + (i * 4), "D").Value Then
Ws.Cells(11 + i, "S").Value = Ws.Cells(18 + (i * 4), "D") - Ws.Cells(18 + (i * 4), "C")
End If

Next i
End If

Call Xfmr_Bold_in_Concatenate1

End Sub
Public Sub Xfmr_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, PN As String

EN = Worksheets("Xfmr Update").Range("M11")
FN = Worksheets("Xfmr Update").Range("Q11")
GN = Worksheets("Xfmr Update").Range("O9")
HN = Worksheets("Xfmr Update").Range("R9")
JN = Worksheets("Xfmr Update").Range("N11")
KN = Worksheets("Xfmr Update").Range("M11")
LN = Worksheets("Xfmr Update").Range("O11")
MN = Worksheets("Xfmr Update").Range("R11")

EM = Worksheets("Xfmr Update").Range("N12")
FM = Worksheets("Xfmr Update").Range("M12")
GM = Worksheets("Xfmr Update").Range("O12")
HM = Worksheets("Xfmr Update").Range("Q12")
KM = Worksheets("Xfmr Update").Range("R12")

Range("C34").Value = ("(" & EN & " : " & " " & GN & " " & JN & " " & LN & " " & "MVA" & "," & " " & HN & " " & FN & " " & MN & " " & "MVA" & ")")
Range("C34").Font.Bold = True
Range("C35").Value = ("(" & FM & " : " & " " & GN & " " & EM & " " & GM & " " & "MVA" & "," & " " & HN & " " & " " & HM & " " & KM & " " & "MVA" & ")")
Range("C35").Font.Bold = True

End Sub
 
Upvote 0
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
When trying to find the right line, sometimes the user may enter the names in the wrong order and it will give no result, resulting in an error. I changed that to a pop up so that they can enter the names in reverse. What if they go through and enter them in reverse and still nothing shows up, I would then need to tell the user that the line is not in the spreadsheet and ask them if it needs to be entered.
How do I make that second error condition work?
 
Upvote 0
I am getting the error Application-defined or object-defined error on the code: With .Cells(lngLastRow, lngColumn)
 
Upvote 0
You must log in or register to reply here.

Similar threads

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

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

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