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
Solved

Copying multiple named ranges onto a Consolidation worksheet

Posted on 2013-10-24
11
229 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
  • 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
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 
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

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
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…

829 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