CODEWITHSUNDEEP
excelvba
Jonathan Nolan
Jonathan Nolan

Reputation: 145

Copy values of named range referenced in another cell

I want to create a loop that copies one range to another, dependent on the value in a list. The list contains the names of all the ranges that I want to copy.

So in this example, PolicyOutput is a named range from DD15:DD77. I want it to update with values from another range, policy1, then loop to copy new values again from a different cell range, policy2.

The list of policies is in a range of cells called PolicyChoice

Each row of PolicyChoice contains a reference to a group of cells. It will be values: policy1, policy2, policy3 etc.

The values of the cells refer to named ranges. For example policy1 is A15:A77, and policy2 is B15:B77

I want A15:A77 to copy to DD15:DD77, then B15:B77 to copy to DD15:DD77, but in a way that can be updated and rerun as the list of "PolicyChoice" is changed by the user.

I tried the code below, but it just copies "policy1" over again into each cell in the range PolicyOutput, instead of the values in the range policy1

policyChoiceCount = (Sheets("RunModel").Range("policyChoice").Count) - Application.WorksheetFunction.CountIf(Sheets("RunModel").Range("policyChoice"), "")

For h = 1 To PolicyChoiceCount
             Sheets(PolicySheetName).Range("PolicyOutput").Value = WorksheetFunction.Index(Sheets("RunModel").Range("policyChoice"), h)

 Next h

Thanks!

Upvotes: 0

Views: 173

Answers (1)

CDP1802
CDP1802

Reputation: 16174

Add Range(WorksheetFunction ..).value like this

Sheets(policySheetName).Range("PolicyOutput").Value = _
Range(WorksheetFunction.Index(Sheets("RunModel").Range("policyChoice"), h)).Value

or in simple steps

Sub mycopy()

    Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet
    Dim rngSource As Range, rngTarget As Range, cell As Range

    Set wb = ThisWorkbook
    Set wsSource = wb.Sheets("RunModel")
    Set wsTarget = wb.Sheets("PolicySheetName")
    Set rngTarget = wsTarget.Range("PolicyOutput")

    For Each cell In wsSource.Range("PolicyChoice")
        If Len(cell) > 0 Then
            On Error Resume Next
            If IsEmpty(Range(cell)) Then
                MsgBox "No named range " & cell, vbCritical, "ERROR"
                Exit Sub
            End If
            On Error GoTo 0

            rngTarget.Value = Range(cell).Value
        End If
    Next

End Sub

Upvotes: 0

Related Questions