Solved

Copying multiple named ranges onto a Consolidation worksheet

Posted on 2013-10-24
11
236 Views
Last Modified: 2013-10-25
Hi,

I have dynamic named ranges in multiple sheets. How can I consolidate all the named ranges together into another sheet?

What I'm trying to replicate is as if I would manually select a named range, copy it, paste its values only into another sheet. Repeat for second range, but insert it Under the pasted range #1, etc.

The problem is I want this to be automatic (without clicking a button, etc.) and don't forget the named ranges are dynamic, so I will be inserting/deleting rows in named ranges here and there, and this needs to be reflected correctly in the consolidated range.

I don't need data validation between ranges.

How can I do this ?
0
Comment
Question by:STIWasabi
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 5
11 Comments
 
LVL 81

Expert Comment

by:byundt
ID: 39597152
Here is a macro that loops through both the global and local named range collections. It stores the consolidation data on a worksheet named Consolidation. Column A is the name, column B is the worksheet name, and column C are the values. Existing data on worksheet Consolidation is cleared at the start of the macro.

When testing on Excel 2013, I found that the local named range collection duplicated the results of the global looping, so I commented that block of code out. It might be required in earlier versions, however.
Sub NameRanger()
Dim ws As Worksheet
Dim rg As Range
Dim nm As Name
Dim i As Long
With Worksheets("Consolidation")    'Copy backed up data to this worksheet
    .Cells.ClearContents
    .Range("A1:C1").Value = Array("Name", "Worksheet", "Values")
    For Each nm In ActiveWorkbook.Names
        Set rg = nm.RefersToRange
        i = .UsedRange.Row + .UsedRange.Rows.Count
        .Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
        .Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count).Value = rg.Value
    Next
    
    'This next block of code is not required in Excel 2013
    'For Each ws In ActiveWorkbook.Worksheets
        'For Each nm In ws.Names
            'Set rg = nm.RefersToRange
            'i = .UsedRange.Row + .UsedRange.Rows.Count
            '.Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
            '.Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count).Value = rg.Value
        'Next
    'Next
End With
End Sub

Open in new window

0
 
LVL 81

Expert Comment

by:byundt
ID: 39597165
As written, the macro does not run automatically. It could be called by a Workbook_WorksheetChange event macro, however. In so doing, any change on any open worksheet would cause the consolidation range to update. Note that you would need to sandwich the macro call between two statements toggling the value of Application.EnableEvents to avoid an infinite cycle of triggering the Workbook_WorksheetChange sub.

Because such an approach would involve considerable overhead, you may want to consider an alternative approach using the Worksheet_Activate event sub. When the user activates the Consolidation worksheet, the consolidation report is updated. You don't need to worry about toggling events with this approach.
0
 

Author Comment

by:STIWasabi
ID: 39597610
I get a run-time error '1004' : Application-defined or object-defined error
on this line :
Set rg = nm.RefersToRange. I use excel 2013.

Trying to implement in my workbook, I notice this happens on as soon as it starts looping on the second name.

Any ideas?
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 81

Expert Comment

by:byundt
ID: 39597692
What is the RefersTo for that second name? I'd like to reproduce your problem at my end.

I added error testing in case the named range doesn't exist in the version of the macro below. You won't get the error previously reported, but neither will the macro report the contents of that range.
Sub NameRanger()
Dim ws As Worksheet
Dim rg As Range
Dim nm As Name
Dim i As Long
With Worksheets("Consolidation")    'Copy backed up data to this worksheet
    .Cells.ClearContents
    .Range("A1:C1").Value = Array("Name", "Worksheet", "Values")
    For Each nm In ActiveWorkbook.Names
        Set rg = Nothing
        On Error Resume Next
        Set rg = nm.RefersToRange
        On Error GoTo 0
        If Not rg Is Nothing Then
            i = .UsedRange.Row + .UsedRange.Rows.Count
            .Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
            .Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count).Value = rg.Value
        End If
    Next
End With
End Sub

Open in new window

0
 

Author Comment

by:STIWasabi
ID: 39598057
See attached.

No more errors but no values either...(I'd like to choose the columns to consolidate if that is possible).

I've added a little msgbox and I noticed that the range names are not consistent. How can I define thescope of each locally instead of globally?

Perhaps the issue is something else.
MASTER.xlsm
0
 
LVL 81

Expert Comment

by:byundt
ID: 39598126
I was not able to replicate your problems with a run-time error, even though I use 32-bit Excel 2013. The macro below has error handling commented out.

When I stepped through the code, I noticed that the row counter i was 1324 when the first named range was being processed. I therefore changed the way that worksheet Consolidation is cleared when the macro starts. I also changed the header labels on worksheet Consolidation.
Sub NameRanger()
Dim ws As Worksheet
Dim rg As Range
Dim nm As Name
Dim i As Long
With Worksheets("Consolidation")    'Copy backed up data to this worksheet
    .UsedRange.EntireRow.Delete
    .Range("A1:C1").Value = Array("Nom", "Feuille", "Valeurs")
    For Each nm In ActiveWorkbook.Names
        Set rg = Nothing
        'On Error Resume Next
        Set rg = nm.RefersToRange
        'On Error GoTo 0
        If Not rg Is Nothing Then
            i = .UsedRange.Row + .UsedRange.Rows.Count
            MsgBox i & " : " & nm.Name
            .Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
            .Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count).Value = rg.Value
        End If
    Next
End With
End Sub

Open in new window

Which column(s) do you want from the named ranges in your Consolidation report?
MASTERnamedRangeConsolidationQ28.xlsm
0
 

Author Comment

by:STIWasabi
ID: 39598276
Since not all sheets does have the same number of columns and that once consolidated they need to fit together, I need two separate logics when pasting to the consolidation sheet (is it also possible to paste format ???)

I'll implement the conditions myself when it's looping but the logics are the following :

logic #1 (column #s below)
1,2,3,7,8,9,14,15,16,17,18,19,20

logic #2 (column #s below, "0" means that I need to insert 0 in the cell via code while looping in orde to have the same # of columns)
1,2,3,4,5,6,11,14,"0",13,"0",12,15

Please note that I cannot simply loop range columns from left to right because of logic #2.

Thanks
0
 
LVL 81

Expert Comment

by:byundt
ID: 39598370
I've added logic to paste the formats as well as values. There are two statements involved. One pastes just values and number formats. The other pastes all formats. If you don't need borders, fonts, highlighting and other formatting copied over, comment out the latter--your macro will run faster.

I also added logic to copy over just certain columns of the named ranges according to two logics. The macro chooses between those logics based on worksheet name, but you could make it based on named range name just as easily. The "Else" block covers all other named ranges--those are copied over in entirety.
Sub NameRanger()
Dim ws As Worksheet
Dim rg As Range
Dim nm As Name
Dim i As Long, j As Long
Dim v As Variant, vLogic1 As Variant, vLogic2 As Variant
Application.ScreenUpdating = False
vLogic1 = Array(1, 2, 3, 7, 8, 9, 14, 15, 16, 17, 18, 19, 20)
vLogic2 = Array(1, 2, 3, 4, 5, 6, 11, 14, 0, 13, 0, 12, 15)
With Worksheets("Consolidation")    'Copy backed up data to this worksheet
    .UsedRange.EntireRow.Delete
    .Range("A1:C1").Value = Array("Nom", "Feuille", "Valeurs")
    For Each nm In ActiveWorkbook.Names
        Set rg = Nothing
        'On Error Resume Next
        Set rg = nm.RefersToRange
        'On Error GoTo 0
        If Not rg Is Nothing Then
            i = .UsedRange.Row + .UsedRange.Rows.Count
            j = 0
            'MsgBox i & " : " & nm.Name
            .Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
            Select Case rg.Worksheet.Name
            Case "PRÉLIM-MEP", "TEST"
                For Each v In vLogic1
                    j = j + 1
                    If v > 0 Then
                        With .Cells(i, j + 2).Resize(rg.Rows.Count, 1)
                            rg.Columns(v).Copy
                            .PasteSpecial xlPasteValuesAndNumberFormats
                            .PasteSpecial xlPasteFormats    'Pastes all formatting, not just number formats
                        End With
                    End If
                Next
            Case "FORMATION", "DICTIONNAIRE"
                For Each v In vLogic2
                    j = j + 1
                    If v > 0 Then
                        With .Cells(i, j + 2).Resize(rg.Rows.Count, 1)
                            rg.Columns(v).Copy
                            .PasteSpecial xlPasteValuesAndNumberFormats
                            .PasteSpecial xlPasteFormats    'Pastes all formatting, not just number formats
                        End With
                    End If
                Next
            Case Else   'Paste all columns
                rg.Copy
                With .Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count)
                    .PasteSpecial xlPasteValuesAndNumberFormats
                    .PasteSpecial xlPasteFormats    'Pastes all formatting, not just number formats
                End With
            End Select
        End If
    Next
End With
End Sub

Open in new window

0
 

Author Comment

by:STIWasabi
ID: 39600137
I've added some tweaking to your code so it works with additional logics of mine. One last request if I may, for the blank columns of logic2: how can I format these columns based on the same range columns right next to their left or right (I need both) of the blank columns?

Let's say the first 0 column has to have the same format than the range column directly to its left and for the second 0, it must be based on the range column directly to its right.

Since they are created manually, I have the correct format everywhere but for those two added columns.

Thanks
0
 
LVL 81

Accepted Solution

by:
byundt earned 500 total points
ID: 39600350
I added an Else clause with Boolean variable to the VLogic2 block of code to handle the case of 0 column and drawing formats either from the left or right.
Sub NameRanger()
Dim ws As Worksheet
Dim rg As Range
Dim nm As Name
Dim i As Long, j As Long
Dim v As Variant, vLogic1 As Variant, vLogic2 As Variant
Dim bZero As Boolean
Application.ScreenUpdating = False
vLogic1 = Array(1, 2, 3, 7, 8, 9, 14, 15, 16, 17, 18, 19, 20)
vLogic2 = Array(1, 2, 3, 4, 5, 6, 11, 14, 0, 13, 0, 12, 15)
With Worksheets("Consolidation")    'Copy backed up data to this worksheet
    .UsedRange.EntireRow.Delete
    .Range("A1:C1").Value = Array("Nom", "Feuille", "Valeurs")
    For Each nm In ActiveWorkbook.Names
        Set rg = Nothing
        'On Error Resume Next
        Set rg = nm.RefersToRange
        'On Error GoTo 0
        If Not rg Is Nothing Then
            i = .UsedRange.Row + .UsedRange.Rows.Count
            j = 0
            'MsgBox i & " : " & nm.Name
            .Cells(i, 1).Resize(1, 2).Value = Array(nm.Name, rg.Worksheet.Name)
            Select Case rg.Worksheet.Name
            Case "PRÉLIM-MEP", "TEST"
                For Each v In vLogic1
                    j = j + 1
                    If v > 0 Then
                        With .Cells(i, j + 2).Resize(rg.Rows.Count, 1)
                            rg.Columns(v).Copy
                            .PasteSpecial xlPasteValuesAndNumberFormats
                            .PasteSpecial xlPasteFormats    'Pastes all formatting, not just number formats
                        End With
                    End If
                Next
            Case "FORMATION", "DICTIONNAIRE"
                For Each v In vLogic2
                    j = j + 1
                    If v > 0 Then
                        With .Cells(i, j + 2).Resize(rg.Rows.Count, 1)
                            rg.Columns(v).Copy
                            .PasteSpecial xlPasteValuesAndNumberFormats
                            .PasteSpecial xlPasteFormats    'Pastes all formatting, not just number formats
                        End With
                    Else
                        With .Cells(i, j + 2).Resize(rg.Rows.Count, 1)
                            If bZero = False Then
                                v = vLogic2(j - 2)          'column to the left
                                bZero = True
                            Else
                                v = vLogic2(j)              'column to the right
                            End If
                            rg.Columns(v).Copy
                            .PasteSpecial xlPasteFormats    'Pastes all formatting, not just number formats
                        End With
                    End If
                Next
            Case Else   'Paste all columns
                rg.Copy
                With .Cells(i, 3).Resize(rg.Rows.Count, rg.Columns.Count)
                    .PasteSpecial xlPasteValuesAndNumberFormats
                    .PasteSpecial xlPasteFormats    'Pastes all formatting, not just number formats
                End With
            End Select
        End If
    Next
End With
End Sub

Open in new window

0
 

Author Comment

by:STIWasabi
ID: 39601809
Perfect, thanks !
0

Featured Post

Enroll in June's Course of the Month

June's Course of the Month is now available! Every 10 seconds, a consumer gets hit with ransomware. Refresh your knowledge of ransomware best practices by enrolling in this month's complimentary course for Premium Members, Team Accounts, and Qualified Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

734 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question