View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Frank Hayes Frank Hayes is offline
external usenet poster
 
Posts: 18
Default Split table into smaller tables & into different worksheets ea

I had to write a macro to do this just yesterday. If you know VBA at all,
you can modify the code to suit your needs. In this example, I was taking
the "Price Sheet" and splitting it into 4 regional worksheets. The 4
regional worksheets were already created. The region name was in column 7
of the Price Sheet.

Good luck

Sub WriteRegions()

' This macro was written by Frank Hayes on May 4, 2007

Application.ScreenUpdating = False

' See how many Rows and Columns are in the selected range
Set ws1 = ActiveWorkbook.Worksheets("Price Sheet")
ws1.Activate
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
P1TotalRows = Selection.Rows.Count
P1TotalCols = Selection.Columns.Count

' Redim the array to match the selected range
ReDim P1Array(1 To P1TotalRows, 1 To P1TotalCols)
ReDim EU_Array(1 To P1TotalRows, 1 To P1TotalCols)
ReDim NA_Array(1 To P1TotalRows, 1 To P1TotalCols)
ReDim AP_Array(1 To P1TotalRows, 1 To P1TotalCols)
ReDim LA_Array(1 To P1TotalRows, 1 To P1TotalCols)

' Load the selected range into an array
ws1.Activate
ws1.Range("PriceData").Select
P1Array = Selection


' Redim the array to match the selected range
NewCols1 = P1TotalCols + 1

' Split the regions
ReDim TempArray(1 To P1TotalRows + 1, 1 To NewCols1)
i = 1
j = 1
k = 1
L = 1

' The column I want to split on is in column 7 in this workbook
SplitCol = 7

For X = 1 To UBound(P1Array)
If P1Array(X, SplitCol) = "REGION NA" Then
For Y = 1 To P1TotalCols
NA_Array(i, Y) = P1Array(X, Y)
Next
i = i + 1
ElseIf P1Array(X, SplitCol) = "EU" Then
For Y = 1 To P1TotalCols
EU_Array(j, Y) = P1Array(X, Y)
Next
j = j + 1
ElseIf P1Array(X, SplitCol) = "AP" Then
For Y = 1 To P1TotalCols
AP_Array(k, Y) = P1Array(X, Y)
Next
k = k + 1
ElseIf P1Array(X, SplitCol) = "LJ" Then
For Y = 1 To P1TotalCols
LA_Array(L, Y) = P1Array(X, Y)
Next
L = L + 1

End If

Next

Sheets("Europe").Range("A2").Resize(UBound(EU_Arra y), P1TotalCols) =
EU_Array
Sheets("North America").Range("A2").Resize(UBound(NA_Array),
P1TotalCols) = NA_Array
Sheets("Latin America").Range("A2").Resize(UBound(LA_Array),
P1TotalCols) = LA_Array
Sheets("Asia Pacific").Range("A2").Resize(UBound(AP_Array), P1TotalCols)
= AP_Array



' Finish Out
Application.ScreenUpdating = True
Application.StatusBar = " "
MsgBox "The regions have been split."


End Sub






"Pradeep" wrote in message
...
Hi Gord,

Thanks for the SortbyColor function link, I was looking at something like
this for sometime. :-)

I guess the example I used was misleading. I just the color as an example.
You are right - the Red, Green, Blue, Yellow etc. are text in the column
on
the basis of which I need to split the whole table.

The problem is that I have a huge database which I need to split. Doing a
custom filter some 30-40 times is tedious, time consuming and there is a
lot
of scope for error while copy-pasting.

Pradeep


"Gord Dibben" wrote:

Pradeep

How are you able to do a custom sort/filter on colored cells?

Are you using a UDF like Chip Pearson's SortbyColor function?

http://www.cpearson.com/excel/SortByColor.htm

Or do you mean the red, green, yellow is text in the cells?


Gord Dibben MS Excel MVP

On Thu, 3 May 2007 05:24:02 -0700, Pradeep

wrote:

Hi,

I have data in a workbook that I need to split into different sheets.

I have a table that has (say) 500 records each for (say) colors Red,
Green
and Yellow (totally 1500 records) in one table. This table needs to be
split
into worksheets, and each sheet to have records only for each colour. I
know
I can do a custom sort (for say records not equal to Red and Green) and
delete the non-relevant records, but I need to do this for very large
tables.
Any help?