Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
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" wrote in message ... 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
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" wrote in message ... 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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
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" wrote in message ... 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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
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" wrote in message ... 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 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
Hi Bob,
For the code to work as posted, using the data given as an example then column A would have to be in Column C, Column B would have to be in Column A and Column C can be in any other column. ie in practice my regional data is in column C, salesman data in column A and data is in other columns Regards Michael |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
Public Sub ProcessData()
Dim i As Long, j 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 Application.DisplayAlerts = 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 For j = wb.Worksheets.Count To wb.Worksheets.Count - 2 Step -1 wb.Worksheets(j).Delete Next j wb.SaveAs ThisWorkbook.Path & _ Application.PathSeparator & ValidFileName(.Cells(i, "C").Value) wb.Close End If Next i Set wb = Nothing Application.DisplayAlerts = True End With End Sub Function ValidFileName(ByVal TheFileName As String) As String Dim RegEx As Object Set RegEx = CreateObject("vbscript.regexp") RegEx.Global = True RegEx.Pattern = "[\\/:\*\?""<\|]" ValidFileName = RegEx.Replace(TheFileName, "") Set RegEx = Nothing End Function -- --- HTH Bob (there's no email, no snail mail, but somewhere should be gmail in my addy) "michael.beckinsale" wrote in message ... Hi Bob, For the code to work as posted, using the data given as an example then column A would have to be in Column C, Column B would have to be in Column A and Column C can be in any other column. ie in practice my regional data is in column C, salesman data in column A and data is in other columns Regards Michael |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
Any ideas on how to do this?
Hi Bob,
Many thanks for your help. Sheets1, Sheets2 etc now being deleted. Function to remove illegal characters is ace! It will be going into my code library. Again many thanks Michael |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Any Ideas? | Excel Programming | |||
Any Ideas? | Excel Worksheet Functions | |||
Ant ideas? | Excel Programming | |||
Ant ideas? | Excel Programming | |||
Any ideas? | Excel Programming |