简体   繁体   中英

Excel 2016 VBA Macro - update various named ranges in an excel workbook using values stored in another workbook

The task is to update several different named ranges in a "Model" workbook with values stored in a "Source" workbook. The "Source" workbook has several columns of information, but there are only 3 columns ("Named Range", "String", "Value") that contain the data to update. These 3 columns also make up the named range "Exceptions".

What's supposed to happen is that the user is prompted to enter the starting and ending row numbers relative to the "Exceptions" they want to push to the "Model" workbook. The idea is that the "Named Range" column of "Exceptions" stores the named range of the corresponding location where the values in "String" and "Value" should go in the "Model". Additionally, the macro is supposed to check if the "String" already exists in the first column of the "Named Range" of the "Model". If not, then the macro is supposed to paste "String" and "Value" at the end of the "Named Range" in the "Model" (and eventually expand the named range to include the new additions).

The code below doesn't run. I've tried replacing the riderrange.Range(___) references with static values and the code works, but the result is the "String" wasn't pasted at the end of the named range.

Within the rows the user selects in the "Source", there could be several of the same "Named Range", so would it be more efficient to update the "Model" in order of "Named Range"s?

I'm working in Excel 2016 on Windows.

Sub BaseSheetUpdate()

Dim startrow As Integer
Dim endrow As Integer
Dim Model As Workbook
Dim Source As Workbook
Dim riderrange As Range

Set Source = ThisWorkbook

Set Model = Workbooks.Open(Filename, _
        ReadOnly:=False, _
        UpdateLinks:=False)

startrow = InputBox("Enter Starting Row Number: ")
endrow = InputBox("Enter Last Row Number: ")

For i = 1 To (endrow - startrow + 1)

Set riderrange = Source.Worksheets("Sheet1").Range("ExceptionsUpdate") _
            .Range("A" & startrow + i - 1 & ":C" & startrow + i - 1)

With Model.Worksheets("Base").Range(riderrange.Range("A" & i).Value).Columns(1)

Set cell = Selection.Find(What:=riderrange.Range("B" & i).Value, LookIn:=xlValues)

If cell Is Nothing Then

.SpecialCells(xlCellTypeLastCell).Offset(1, 0).Value = riderrange.Range("B" & i & ":C" & i)

Else
    'If any of the "String"s already exists in the named range, the goal is to store the "String"s in a list and print a message to the user at the end saying "These strings already exist in the model."

End If

End With

Next i

End Sub

I figured out a solution and have updated the code to share. Let me know if you see any opportunity for consolidation or improvement. Thanks

Sub BaseSheetUpdate()

Dim startrow As Integer
Dim endrow As Integer
Dim Model As Workbook
Dim Source As Workbook
Dim riderrange As Range
Dim BSK As Variant

Set Source = ThisWorkbook

Set Model = Workbooks.Open(Filename, _
        ReadOnly:=False, _
        UpdateLinks:=False)

startrow = InputBox("Enter Starting Row Number: ")
endrow = InputBox("Enter Last Row Number: ")

For i = 1 To (endrow - startrow + 1)

Set riderrange = Source.Worksheets("Sheet1").Range("ExceptionsUpdate") _
            .Range("A" & startrow + i - 1 & ":C" & startrow + i - 1)

With Model.Worksheets("Sheet1").Range(riderrange.Range("A1"))

    .Select

        Set cell = Selection.Find(What:=riderrange.Range("B1"), LookIn:=xlValues)

        'If the BSK isn't in the named range, then the BSK and value are pasted at the end of the named range in the model

        If cell Is Nothing Then

            .End(xlDown).Offset(1, 0).Value = riderrange.Range("B1")
            .End(xlDown).Offset(0, 1).Value = riderrange.Range("C1")

        Else

            'If the BSK already exists in Sheet1, then the BSK is saved to the BSK variable for reporting at the end of the loop.

            BSK = BSK & vbCrLf & riderrange.Range("B1").Value

        End If

    End With

End If

Next i

MsgBox "Model update complete."

'Any BSK's that aren't updated will be displayed in a messagebox to the user.

If BSK > 0 Then

MsgBox "The following BSK's were not added:" & vbCrLf & BSK, vbExclamation, "DANGER! DANGER!"

Else
Workbooks(Model).Close SaveChanges:=True
End If

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM