Solved

Check for more sheets and merge

Posted on 2014-07-28
10
78 Views
Last Modified: 2014-07-29
Hi,

I have a some code below. The code looks for the three sheets "Incountry", "Inbound" and "Outbound"

Ive just realised a system we use downloads into excel 2007, limiting it to 65k rows, so if inbound has 220k rows, i will receive three tabs "Inbound", "inbound_1" & "Inbound_2", the same applies for "Outbound" and "Incountry"

So i need my code to check for whether these sheets exist and then append them to the destination tab "Combined Data"

Im not sure how to check, as there may be one addtional tab or there may be 10, so i cant hardcode the possible names.

So i need the code to somehow check if these addtional tabs exist and if they do, add to combined.

Thanks

Code -
Dim wsDestination As Worksheet
Sub merge()


On Error Resume Next
Application.DisplayAlerts = False
Sheets("Combined Data").Delete
Application.DisplayAlerts = True
On Error GoTo 0


Set wsDestination = Sheets.Add
wsDestination.Name = "Combined Data"
Sheets("Incountry").Range("A1:AT1").Copy Sheets("Combined Data").Range("A1:AT1")

Call CopyFromSheet(Sheets("Incountry"))
Call CopyFromSheet(Sheets("Inbound"))
Call CopyFromSheet(Sheets("Outbound"))

End Sub

Sub CopyFromSheet(wsSource As Worksheet)

Dim FromRange As Range
Set FromRange = wsSource.Range("A2:AT" & wsSource.Range("A" & Rows.Count).End(xlUp).Row)

FromRange.Copy wsDestination.Range("A" & wsDestination.Range("A" & Rows.Count).End(xlUp).Row + 1)

End Sub

Open in new window

0
Comment
Question by:Seamus2626
  • 5
  • 4
10 Comments
 
LVL 45

Expert Comment

by:aikimark
ID: 40224836
Did you mean to state Excel 2003?  Because Excel 2007 has a 1M row limit, not 64K row limit.
0
 

Author Comment

by:Seamus2626
ID: 40226101
Yep, i meant 2003 aikimark , il remember to put into snippet

thanks
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40226480
Here are two examples of iterating the worksheets for your problem.  You would replace the Debug.Print statement with the transfer of data to your consolidated worksheet.
Old fashioned way:
Option Explicit

Sub Q_28485478()
    Dim ws As Worksheet
    Dim vItem As Variant
    Dim lngExtra As Long
    
    On Error Resume Next
    For Each vItem In Array("Inbound", "Outbound", "Incountry")
        If Len(Worksheets(vItem).Name) <> 0 Then
            Debug.Print vItem, "exists"
            For lngExtra = 1 To Sheets.Count
                If Len(Worksheets(vItem & "_" & lngExtra).Name) <> 0 Then
                    If Err <> 0 Then
                        Err.Clear
                        Exit For
                    End If
                    Debug.Print , vItem & "_" & lngExtra, "exists"
                End If
            Next
        End If
    Next
End Sub

Open in new window


Preferred Way:
Option Explicit

Sub Q_28485478_dic()
    Dim ws As Worksheet
    Dim vItem As Variant
    Dim lngExtra As Long
    Dim dicSheets As Object
    Set dicSheets = CreateObject("scripting.dictionary")
    
    For Each ws In Worksheets
        dicSheets.Add ws.Name, 1
    Next
    
    For Each vItem In Array("Inbound", "Outbound", "Incountry")
        If dicSheets.exists(vItem) Then
            Debug.Print vItem, "exists"
            For lngExtra = 1 To Worksheets.Count
                If dicSheets.exists(vItem & "_" & lngExtra) Then
                    Debug.Print , vItem & "_" & lngExtra, "exists"
                Else
                    Exit For
                End If
            Next
        End If
    Next
End Sub

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 40226486
There is another way to do what you want to do, but it involves iterating all the worksheets for every search, which is inefficient.
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Author Comment

by:Seamus2626
ID: 40226593
Thanks Aikimark, i went with the below, however i get an error "Argument not optional" on line

                 CopyFromSheet , vItem & "_" & lngExtra, "exists"

That was my attempt at bringing the in transfer!

Thanks


Sub Q_28485478_dic()
    Dim ws As Worksheet
    Dim vItem As Variant
    Dim lngExtra As Long
    Dim dicSheets As Object
    Set dicSheets = CreateObject("scripting.dictionary")
    
    For Each ws In Worksheets
        dicSheets.Add ws.Name, 1
    Next
    
    For Each vItem In Array("Inbound", "Outbound", "Incountry")
        If dicSheets.exists(vItem) Then
            Debug.Print vItem, "exists"
            For lngExtra = 1 To Worksheets.Count
                If dicSheets.exists(vItem & "_" & lngExtra) Then
                 CopyFromSheet , vItem & "_" & lngExtra, "exists"
                Else
                    Exit For
                End If
            Next
        End If
    Next
End Sub

Open in new window

0
 
LVL 45

Accepted Solution

by:
aikimark earned 500 total points
ID: 40226807
You forgot to remove the , "exists" from my Debug.Print statement and you have an extra comma before the parameter.
You probably should use:
CopyFromSheet Worksheets(vItem)

CopyFromSheet Worksheets(vItem & "_" & lngExtra)

Open in new window

0
 

Author Comment

by:Seamus2626
ID: 40226866
This is great, however, i have realised a problem, my copy code below excludes the first row when copying, however in the additional sheets, there are no headings, im not sure should i raise this as a seperate question, but basically il need the code to recognise that the additional sheets have row one copied too......

Thanks

Sub CopyFromSheet(wsSource As Worksheet)

Dim FromRange As Range
Set FromRange = wsSource.Range("A2:AT" & wsSource.Range("A" & Rows.Count).End(xlUp).Row)

FromRange.Copy wsDestination.Range("A" & wsDestination.Range("A" & Rows.Count).End(xlUp).Row + 1)

End Sub

Open in new window

0
 

Author Closing Comment

by:Seamus2626
ID: 40226983
All good, managed to work that part out!

Thank you so much aikimark, thats a sweet piece of code!

Thanks
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40226984
add a parameter to your routine that allows the invoking code to specify whether to include the first row or not.  Perhaps, make it an optional parameter with some desired value.  Perhaps make it the starting row number.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
splitting text of cell to columns 14 24
Help with Excel formula 6 38
Dynamic Filter ? 4 20
Vlookup formula error 15 11
INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
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 Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

920 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now