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
Excel VBA advice before I start the code...
-
- gamma jay
- Posts: 25455
- Joined: 17 Mar 2010, 17:33
- Location: Cape Town
Excel VBA advice before I start the code...
Regards,
Rudi
If your absence does not affect them, your presence didn't matter.
Rudi
If your absence does not affect them, your presence didn't matter.
-
- Administrator
- Posts: 78574
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Excel VBA advice before I start the code...
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.
-- 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
Hans
-
- gamma jay
- Posts: 25455
- Joined: 17 Mar 2010, 17:33
- Location: Cape Town
Re: Excel VBA advice before I start the code...
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.
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.
Rudi
If your absence does not affect them, your presence didn't matter.
-
- gamma jay
- Posts: 25455
- Joined: 17 Mar 2010, 17:33
- Location: Cape Town
Re: Excel VBA advice before I start the code...
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...
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.
Rudi
If your absence does not affect them, your presence didn't matter.
-
- Administrator
- Posts: 78574
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Excel VBA advice before I start the code...
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
Hans
-
- gamma jay
- Posts: 25455
- Joined: 17 Mar 2010, 17:33
- Location: Cape Town
Re: Excel VBA advice before I start the code...
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...
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...
Regards,
Rudi
If your absence does not affect them, your presence didn't matter.
Rudi
If your absence does not affect them, your presence didn't matter.
-
- Administrator
- Posts: 78574
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Excel VBA advice before I start the code...
Yep, I have some very specific coding preferences...
I kept some of yours too, however.
I kept some of yours too, however.
Best wishes,
Hans
Hans
-
- gamma jay
- Posts: 25455
- Joined: 17 Mar 2010, 17:33
- Location: Cape Town
Re: Excel VBA advice before I start the code...
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.
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.
Regards,
Rudi
If your absence does not affect them, your presence didn't matter.
Rudi
If your absence does not affect them, your presence didn't matter.
-
- Administrator
- Posts: 78574
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Excel VBA advice before I start the code...
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
Hans
-
- gamma jay
- Posts: 25455
- Joined: 17 Mar 2010, 17:33
- Location: Cape Town
Re: Excel VBA advice before I start the code...
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. again!
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. again!
Regards,
Rudi
If your absence does not affect them, your presence didn't matter.
Rudi
If your absence does not affect them, your presence didn't matter.