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.