Check for more sheets and merge

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

Seamus2626Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

aikimarkCommented:
Did you mean to state Excel 2003?  Because Excel 2007 has a 1M row limit, not 64K row limit.
0
Seamus2626Author Commented:
Yep, i meant 2003 aikimark , il remember to put into snippet

thanks
0
aikimarkCommented:
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
Cloud Class® Course: CompTIA Healthcare IT Tech

This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.

aikimarkCommented:
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
Seamus2626Author Commented:
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
aikimarkCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Seamus2626Author Commented:
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
Seamus2626Author Commented:
All good, managed to work that part out!

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

Thanks
0
aikimarkCommented:
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.