Solved

Check for more sheets and merge

Posted on 2014-07-28
10
77 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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

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

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

What is a Form List Box? (skip if you know this) The forms List Box is the alternative to the ActiveX list box. If you are using excel 2007, you first make sure you have a developer tab (click the Orb)->"Excel Options"->Popular->"Show Developer tab…
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…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

708 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

13 Experts available now in Live!

Get 1:1 Help Now