Hi All,

I have a table of data that looks some thing like this:

Column A Column B Column C
British Isles Salesman A 123
British Isles Salesman A 345
British Isles Salesman A 123456
British Isles Salesman B 9876
British Isles Salesman B 6789
British Isles Salesman C 7532
Europe Salesman 1 98475
Europe Salesman 1 9692
Europe Salesman 1 598310
Europe Salesman 2 6533
Europe Salesman 2 35678
Europe Salesman 3 9643
Europe Salesman 3 1423
Europe Salesman 4 7643
etc

What l want to do is create the following using the data in the table:

A workbook called 'Britsh Isles' with sheets for each salesman
containing each row of data
A workbook called 'Europe' with sheets for each salesman containing
each row of data

There will always be a variable number of Regions, Salesman & Data
rows

The workbooks should ideally be saved in the same directory as the
originating workbook.

Does anybody have any VBA code to achieve this or can they point me in
the right direction please?

All ideas gratefully received.

Regards

Michael

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim StartAt As Long
Dim wb As Workbook

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
StartAt = 1
For i = 2 To LastRow + 1

If .Cells(i, "A").Value <> .Cells(i - 1, "A").Value Then

Set wb = Workbooks.Add
.Rows(StartAt).Resize(i - StartAt).Copy
wb.Worksheets(1).Range("A1")
wb.SaveAs .Path & Application.PathSeparator & .Cells(i - 1,
"A").Value
wb.Close
StartAt = 1
End If
Next i

Set wb = Nothing
End With

End Sub

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)



"michael.beckinsale" <(E-Mail Removed)> wrote in message
news:5faf380d-ab54-44a9-a226-(E-Mail Removed)...
> Hi All,
>
> I have a table of data that looks some thing like this:
>
> Column A Column B Column C
> British Isles Salesman A 123
> British Isles Salesman A 345
> British Isles Salesman A 123456
> British Isles Salesman B 9876
> British Isles Salesman B 6789
> British Isles Salesman C 7532
> Europe Salesman 1 98475
> Europe Salesman 1 9692
> Europe Salesman 1 598310
> Europe Salesman 2 6533
> Europe Salesman 2 35678
> Europe Salesman 3 9643
> Europe Salesman 3 1423
> Europe Salesman 4 7643
> etc
>
> What l want to do is create the following using the data in the table:
>
> A workbook called 'Britsh Isles' with sheets for each salesman
> containing each row of data
> A workbook called 'Europe' with sheets for each salesman containing
> each row of data
>
> There will always be a variable number of Regions, Salesman & Data
> rows
>
> The workbooks should ideally be saved in the same directory as the
> originating workbook.
>
> Does anybody have any VBA code to achieve this or can they point me in
> the right direction please?
>
> All ideas gratefully received.
>
> Regards
>
> Michael

This works:

Option Base 1
Option Explicit

Sub SplitSalesData()
Dim DataArray(50000, 3) As Variant
Dim fnd As Double
Dim x As Double
Dim y As Double
Dim SlsPeople(500, 2) As Variant
Dim Sls As Double
Dim Found As Integer
Dim Z As Double
Dim W As Double
Dim Locations(500, 2) As Variant
Dim NbrLoc As Double

Sheets("MainDataSheet").Select '<--Change name to what it is
x = 1
Do While True
If Cells(x, 1).Value = Empty Then Exit Do
Found = 0
For y = 1 To Sls
If SlsPeople(y, 1) = Cells(x, 2).Value Then
Found = 1
Exit For
End If
Next
If Found = 0 Then
Sls = Sls + 1
SlsPeople(Sls, 1) = Cells(x, 2).Value
SlsPeople(Sls, 2) = Cells(x, 1).Value
End If

Found = 0
For y = 1 To NbrLoc
If Locations(y, 1) = Cells(x, 1).Value Then
Found = 1
Exit For
End If
Next
If Found = 0 Then
NbrLoc = NbrLoc + 1
Locations(NbrLoc, 1) = Cells(x, 1).Value
End If


fnd = fnd + 1
For y = 1 To 3
DataArray(fnd, y) = Cells(x, y).Value
Next
x = x + 1
Loop

Dim MyEntries As String
Dim NewWks As Worksheet



For W = 1 To NbrLoc
Workbooks.Add Template:="Workbook"
MyEntries = ActiveWorkbook.Name
For y = 1 To Sls
If SlsPeople(y, 2) = Locations(W, 1) Then
Z = 1
Set NewWks = Worksheets.Add
NewWks.Name = SlsPeople(y, 1)
Cells(1, 1).Value = "Salesman"
Cells(1, 2).Value = "Amount"
For x = 1 To fnd
If DataArray(x, 2) = SlsPeople(y, 1) Then
Z = Z + 1
Cells(Z, 1).Value = DataArray(x, 2)
Cells(Z, 2).Value = DataArray(x, 3)
End If
Next
End If
Next
ActiveWorkbook.SaveAs Filename:="C:\TEMP\" & Locations(W, 1) & ".xlsx",
FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False

Next
End Sub


"michael.beckinsale" wrote:

> Hi All,
>
> I have a table of data that looks some thing like this:
>
> Column A Column B Column C
> British Isles Salesman A 123
> British Isles Salesman A 345
> British Isles Salesman A 123456
> British Isles Salesman B 9876
> British Isles Salesman B 6789
> British Isles Salesman C 7532
> Europe Salesman 1 98475
> Europe Salesman 1 9692
> Europe Salesman 1 598310
> Europe Salesman 2 6533
> Europe Salesman 2 35678
> Europe Salesman 3 9643
> Europe Salesman 3 1423
> Europe Salesman 4 7643
> etc
>
> What l want to do is create the following using the data in the table:
>
> A workbook called 'Britsh Isles' with sheets for each salesman
> containing each row of data
> A workbook called 'Europe' with sheets for each salesman containing
> each row of data
>
> There will always be a variable number of Regions, Salesman & Data
> rows
>
> The workbooks should ideally be saved in the same directory as the
> originating workbook.
>
> Does anybody have any VBA code to achieve this or can they point me in
> the right direction please?
>
> All ideas gratefully received.
>
> Regards
>
> Michael
>

Hi Bob,

Your a genius, it looks exactly like what l want.

Havn't tried it yet but will post back if any questions

Thank you very much

Regards

Michael

Hi Bob,

Unfortunately the code doesn't work properly. Probably my explanation
of what was wanted.

1) Code does not allow for column header
2) Code does not create new sheet for each for each salesman and name
sheet as salesman
3) wb.SaveAs .Path etc errors out

Can you help rectify this please

Regards

Michael

Public Sub ProcessData()
Dim Wb As Workbook
Dim rngRegion As Range
Dim i As Long
Dim LastRow As Long
Dim StartAt As Long
Dim NumSheets As Long
Dim EvalFormula As String

Const Formula As String = _
"SUMPRODUCT((B<start>:B<end><>"""")/COUNTIF(B<start>:B<end>,B<start>:B<end>&""""))"

NumSheets = Application.SheetsInNewWorkbook
With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
StartAt = 2
i = 2
For i = 3 To LastRow + 1

If .Cells(i, "A").Value <> .Cells(i - 1, "A").Value Then

EvalFormula = Replace(Formula, "<start>", StartAt)
EvalFormula = Replace(EvalFormula, "<end>", i - 1)
EvalFormula = Replace(EvalFormula, "<region>",
..Cells(StartAt, "A"))
Application.SheetsInNewWorkbook = .Evaluate(EvalFormula)
Set Wb = Workbooks.Add
.Rows(StartAt).Resize(i - StartAt).Copy _
Wb.Worksheets(1).Range("A2")
.Rows(1).Copy Wb.Worksheets(1).Range("A1")
Call SplitSheets(Wb, StartAt - i)
Wb.SaveAs .Parent.Path & Application.PathSeparator &
..Cells(i - 1, "A").Value
Wb.Close
StartAt = i
End If
Next i

Set Wb = Nothing
End With

Application.SheetsInNewWorkbook = NumSheets
End Sub

Private Sub SplitSheets(ByRef Wb As Workbook, ByVal NumRows As Long)
Dim SheetNum As Long
Dim StartAt As Long
Dim DeleteFrom As Long
Dim i As Long

With Wb.Worksheets(1)

i = 2
'let's leave the first Salesman on sheet 1
Do
i = i + 1
Loop Until .Cells(i, "B").Value <> .Range("B2").Value
.Name = .Range("B2").Value
.Columns("A:C").AutoFit

SheetNum = 2
DeleteFrom = i
StartAt = i
Do
i = i + 1
If .Cells(i - 1, "A").Value <> "" Then

If .Cells(i, "B").Value <> .Cells(StartAt, "B").Value Then

.Rows(StartAt).Resize(i - StartAt).Copy _
Wb.Worksheets(SheetNum).Range("A2")
.Rows(1).Copy Wb.Worksheets(SheetNum).Range("A1")
Wb.Worksheets(SheetNum).Name = .Cells(StartAt,
"B").Value
Wb.Worksheets(SheetNum).Columns("A:C").AutoFit
StartAt = i
SheetNum = SheetNum + 1
End If
End If
Loop Until .Cells(i - 1, "A").Value <> .Range("A2").Value
.Rows(DeleteFrom).Resize(i - DeleteFrom).Delete
End With
End Sub




--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"michael.beckinsale" <(E-Mail Removed)> wrote in message
news:345ec0fc-04ba-4aab-a678-(E-Mail Removed)...
> Hi Bob,
>
> Unfortunately the code doesn't work properly. Probably my explanation
> of what was wanted.
>
> 1) Code does not allow for column header
> 2) Code does not create new sheet for each for each salesman and name
> sheet as salesman
> 3) wb.SaveAs .Path etc errors out
>
> Can you help rectify this please
>
> Regards
>
> Michael
>

Hi Bob,

Thats some coding, not sure l fully understand it, l will give it a
try and see if it is more efficient than what l came up with (l'm sure
it will be!)

The code l am using is posted below. Would you be kind enough to give
it a quick 'once over' to ensure that l have not overlooked some
eventuality l haven't thiught of?

Public Sub ProcessData()

Dim i As Long
Dim r As Long
Dim LastRow As Long
Dim StartAt As Long
Dim wb As Workbook
Dim sh As String

Application.ScreenUpdating = False

With ActiveSheet
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
StartAt = 1
For i = 2 To LastRow
If .Cells(i, "C").Value <> .Cells(i - 1, "C").Value Then
Set wb = Workbooks.Add
End If
If .Cells(i, "A").Value <> .Cells(i - 1, "A").Value Then
sh = .Cells(i, "A").Value
wb.Sheets.Add
wb.ActiveSheet.Name = sh
.Rows(1).Copy wb.Worksheets(sh).Range("A1")
r = 2
End If
.Rows(i).Copy wb.Worksheets(sh).Range("A" & r)
r = r + 1
If .Cells(i, "C").Value <> .Cells(i + 1, "C").Value Then
wb.SaveAs ThisWorkbook.Path & Application.PathSeparator
& .Cells(i, "C").Value
wb.Close
End If
Next i
Set wb = Nothing
End With


End Sub

Regards

Michael

A quick look at this suggests that you create a new workbook per salesman. I
thought you wanted a new workbook per region, new sheet per salesman.

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"michael.beckinsale" <(E-Mail Removed)> wrote in message
news:b9bd211f-31bb-44ba-8e4e-(E-Mail Removed)...
> Hi Bob,
>
> Thats some coding, not sure l fully understand it, l will give it a
> try and see if it is more efficient than what l came up with (l'm sure
> it will be!)
>
> The code l am using is posted below. Would you be kind enough to give
> it a quick 'once over' to ensure that l have not overlooked some
> eventuality l haven't thiught of?
>
> Public Sub ProcessData()
>
> Dim i As Long
> Dim r As Long
> Dim LastRow As Long
> Dim StartAt As Long
> Dim wb As Workbook
> Dim sh As String
>
> Application.ScreenUpdating = False
>
> With ActiveSheet
> LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
> StartAt = 1
> For i = 2 To LastRow
> If .Cells(i, "C").Value <> .Cells(i - 1, "C").Value Then
> Set wb = Workbooks.Add
> End If
> If .Cells(i, "A").Value <> .Cells(i - 1, "A").Value Then
> sh = .Cells(i, "A").Value
> wb.Sheets.Add
> wb.ActiveSheet.Name = sh
> .Rows(1).Copy wb.Worksheets(sh).Range("A1")
> r = 2
> End If
> .Rows(i).Copy wb.Worksheets(sh).Range("A" & r)
> r = r + 1
> If .Cells(i, "C").Value <> .Cells(i + 1, "C").Value Then
> wb.SaveAs ThisWorkbook.Path & Application.PathSeparator
> & .Cells(i, "C").Value
> wb.Close
> End If
> Next i
> Set wb = Nothing
> End With
>
>
> End Sub
>
> Regards
>
> Michael

Hi Bob,

I structured my example as Region, Salesman, Data because it seems
more logical and easier for the reader to understand what was
required.

In practice the 'database' columns appear as Salesman, Region, Data
with columns preceding, between and after.

You are correct that l want a new workbook for each Region and a sheet
for each salesman.

My code seems to be working fine but with a couple of minor irritants:

1) I end up with unwanted sheets ie sheet1, sheet2, sheet3
2) If the region name has an illegal character (/?\!*<>:|) the code
errors out

Any idea how to overcome these shortcomings?

For the moment l have decided to stick with my code as when l have to
re-visit during development l will be able to follow it. When l get
time to fully study & understand your code l may replace it.

Many thanks for your help & patience so far. Hope you help with the
outstanding issues.

Regards

Michael

Have you hanged the order of the data. This bombs on me, after creating
workbook called 123.xls

--
---
HTH

Bob


(there's no email, no snail mail, but somewhere should be gmail in my addy)



"michael.beckinsale" <(E-Mail Removed)> wrote in message
news:db18b1bb-9a9d-4c28-a7ef-(E-Mail Removed)...
> Hi Bob,
>
> I structured my example as Region, Salesman, Data because it seems
> more logical and easier for the reader to understand what was
> required.
>
> In practice the 'database' columns appear as Salesman, Region, Data
> with columns preceding, between and after.
>
> You are correct that l want a new workbook for each Region and a sheet
> for each salesman.
>
> My code seems to be working fine but with a couple of minor irritants:
>
> 1) I end up with unwanted sheets ie sheet1, sheet2, sheet3
> 2) If the region name has an illegal character (/?\!*<>:|) the code
> errors out
>
> Any idea how to overcome these shortcomings?
>
> For the moment l have decided to stick with my code as when l have to
> re-visit during development l will be able to follow it. When l get
> time to fully study & understand your code l may replace it.
>
> Many thanks for your help & patience so far. Hope you help with the
> outstanding issues.
>
> Regards
>
> Michael
>