Excel VBA advice before I start the code...

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Excel VBA advice before I start the code...

Post by Rudi »

Hi,

I have a workbook that contains 500+ sheets (not my design!!).
From sheets 3 till the last sheet have a Confirmation of Transfer form that contains a branch in cell L10.
I need to extract a copy of these sheets into new workbooks grouped by the branch. Each workbook will also be saved by with the name of the branch.
The branch entries per sheet are not in order. Sheet 3 might have Branch1, sheet 4 has Branch28, sheet 5 has Branch1, etc...

What would be the best course of action?
-- Store the branch and sheet name in an array, sort the array by branch and copy the sheets to new workbooks looping the array
-- Loop the workbook and write the data to a new sheet, then sort and loop this sheet to extract to new workbooks
-- Copy each sheet in sequence 3 to end, copying it to workbooks assigned to that branch (We might have many workbooks open at any given point??)
-- Any better ideas to optimise this?

TX
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Excel VBA advice before I start the code...

Post by HansV »

I'd go with the second option:

-- Loop the workbook and write the data to a new sheet, then sort and loop this sheet to extract to new workbooks

Having the sheet names and branch names in a list on a worksheet should make for efficient looping, and it is useful as documentation too.
Best wishes,
Hans

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Excel VBA advice before I start the code...

Post by Rudi »

Hi,

I'm a bit stuck on the moving of the sheets to the new workbooks. I'm not sure where to put the Workbooks.Add statement?
If I put it in the loop, a new book is created for each cell in the list.
If I put it in the true part of the IF clause it creates a new book for each cell.

Any ideas?
TX

Attached:
Transfer Certs.xlsx: is the test workbook to open and collect L10 branch name...
Extract Branches.xlsm: is the template containing the macro which will prompt for Transfer Certs.
You do not have the required permissions to view the files attached to this post.
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Excel VBA advice before I start the code...

Post by Rudi »

Just thinking:
Calculate the unique count of branches from the list
Create an outer loop to loop the branch count...and each iteration of this loop adds a new book...

Sounds achievable...
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Excel VBA advice before I start the code...

Post by HansV »

Try this version:

Code: Select all

Sub ExtractBranches()
    Dim sFile As String
    Dim i As Integer
    Dim wbkS As Workbook ' Transfer Certificates workbook
    Dim wbkT As Workbook ' New workbook
    Dim wbkC As Workbook ' This workbook
    Dim wshC As Worksheet ' BranchList sheet
    Dim sBranch As String

    Set wbkC = ThisWorkbook
    sFile = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , _
        "Browse and open the Transfer Certificates file.")
    If sFile = "False" Then Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wbkS = Workbooks.Open(Filename:=sFile, UpdateLinks:=False)

    On Error Resume Next
    wbkC.Worksheets("BranchList").Delete
    On Error GoTo 0
    Set wshC = wbkC.Worksheets.Add(Before:=wbkC.Worksheets(1))
    wshC.Name = "BranchList"
    wshC.Range("A1:B1").Value = Array("Branch", "SheetName")
    For i = 3 To wbkS.Worksheets.Count
        wshC.Range("A" & (i - 1)).Value = wbkS.Worksheets(i).Range("L10").Value
        wshC.Range("B" & (i - 1)).Value = wbkS.Worksheets(i).Name
    Next i

    wshC.Range("A1").CurrentRegion.Sort _
        Key1:=wshC.Range("A1"), Header:=xlYes

    With wshC
        For i = 2 To wbkS.Worksheets.Count
            If .Range("A" & i).Value = .Range("A" & (i - 1)).Value Then
                wbkS.Worksheets(.Range("B" & i).Value).Copy Before:=wbkT.Worksheets(1)
            Else
                If i > 2 Then
                    wbkT.SaveAs Filename:=wbkC.Path & "\" & sBranch & ".xlsx", _
                        FileFormat:=51
                    wbkT.Close SaveChanges:=False
                End If
                If i < wbkS.Worksheets.Count Then
                    wbkS.Worksheets(.Range("B" & i).Value).Copy
                    Set wbkT = ActiveWorkbook
                    sBranch = .Range("A" & i).Value
                End If
            End If
        Next i
    End With

    wbkS.Close SaveChanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Excel VBA advice before I start the code...

Post by Rudi »

Wow...you have almost entirely rewritten the code. I wasn't expecting you to go to such measures.
Obviously this is in the style that you code and are comfortable with. (Actually, if I scan code blocks in the forum, I can easily spot yours...you have a definite style to how you write code!)

If you don't mind, I'll test it tomorrow...
I think I must go to bed now.

TX again... :cheers:
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Excel VBA advice before I start the code...

Post by HansV »

Yep, I have some very specific coding preferences... :grin:
I kept some of yours too, however.
Best wishes,
Hans

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Excel VBA advice before I start the code...

Post by Rudi »

Hi,

I ran your code on the actual file and it ran smoothly.
Many TX for your guidance and code.
I understand your code after stepping through it, but how you come up with these different logical expressions is a mystery. :cheers: :chocciebar: :smile:
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Excel VBA advice before I start the code...

Post by HansV »

Although your problem has been solved, here is a version with some comments, and with more meaningful variable names.

Code: Select all

Sub ExtractBranches()
    Dim strFile As String ' Path of Transfer Certificates workbook
    Dim i As Integer ' Loop counter
    Dim lngCount As Long ' Loop limit
    Dim wbkSource As Workbook ' Transfer Certificates workbook
    Dim wbkTarget As Workbook ' New workbook
    Dim wbkList As Workbook ' This workbook
    Dim wshList As Worksheet ' BranchList sheet
    Dim strBranch As String ' Name of branch
    Dim strNewBranch As String ' Name of 'current' branch
    Dim strSheet As String ' Name of sheet

    Set wbkList = ThisWorkbook

    ' Open Transfer Certificates workbook
    strFile = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , _
        "Browse and open the Transfer Certificates file.")
    If strFile = "False" Then Exit Sub

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wbkSource = Workbooks.Open(Filename:=strFile, UpdateLinks:=False)
    lngCount = wbkSource.Worksheets.Count

    ' Create list of branch and sheet names
    On Error Resume Next
    wbkList.Worksheets("BranchList").Delete
    On Error GoTo 0
    Set wshList = wbkList.Worksheets.Add(Before:=wbkList.Worksheets(1))
    wshList.Name = "BranchList"
    wshList.Range("A1:B1").Value = Array("Branch", "SheetName")
    For i = 3 To lngCount
        With wbkSource.Worksheets(i)
            wshList.Range("A" & (i - 1)).Value = .Range("L10").Value
            wshList.Range("B" & (i - 1)).Value = .Name
        End With
    Next i

    ' Sort the list
    wshList.Range("A1").CurrentRegion.Sort _
        Key1:=wshList.Range("A1"), Header:=xlYes

    ' Loop through sheets/branches
    For i = 2 To lngCount
        strNewBranch = wshList.Range("A" & i).Value
        strSheet = wshList.Range("B" & i).Value
        ' Same branch?
        If strNewBranch = strBranch Then
            ' Copy sheet to already created workbook
            wbkSource.Worksheets(strSheet).Copy Before:=wbkTarget.Worksheets(1)
        Else
            ' Save 'previous' new workbook except when we just started
            If i > 2 Then
                ' Save workbook
                wbkTarget.SaveAs Filename:=wbkList.Path & "\" & strBranch & ".xlsx", _
                    FileFormat:=xlOpenXMLWorkbook
                wbkTarget.Close SaveChanges:=False
            End If
            ' Copy sheet except when we're past the end of the list
            If i < lngCount Then
                ' Copy sheet, creating a new workbook
                wbkSource.Worksheets(strSheet).Copy
                ' The new workbook is now the active workbook
                Set wbkTarget = ActiveWorkbook
                ' Remember branch name
                strBranch = strNewBranch
            End If
        End If
    Next i

    ' Close Transfer Certificates workbook
    wbkSource.Close SaveChanges:=False

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Excel VBA advice before I start the code...

Post by Rudi »

TX for the documentation. It will be clearer for others also browsing this thread to understand the context of the code.

Though I used your code to resolve the process, I had "in theory and untested" determined that my query could also have been resolved with the epiphany I had regarding an extra loop for the Workbook.Add issue. I was going to use a loop: For b = 2 to iCount (where iCount used an =SUM(1/COUNTIF(...)) function to calculate the amount of unique Branches and then loop and create a new book each iteration, and then add the sheets with the inside loop.

Anyways, what ever construct the code takes....as long as it works. :cheers: again!
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.