Sorting Info from a WS to multiple Worksheets..

M

MikeyJ110

New Member
Joined
Sep 30, 2009
Messages
6
So, I use to be a lot better with Excel, but it's been quite some time, and I'm in Dire need of help.

Here's the issue: I have a spreadsheet with 12,000 contacts in it (name, email, phone number, country, industry, etc etc). The sheet is kind of messy, and I want to clean it up. One way thing I want to do is organize it. I want to sort the Master sheet into other worksheets, and I would like to do this Industry.

Is there a way to make excel register when a contact is in a certain industry, and then subsequently move that contact into a sheet? I tried playing around with If/Then functions, but I think this is a job for a macro/VB expert.

Your help would be greatly appreciated. mjulian@bowdoin.edu

In addition, any other tips to better organize a workbook of this size would be welcomed, and appreciated!

-Mike
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
Hi Mike

Welcome to the board!

We could probably provide a worksheet_change event macro that will move entries to the appropriate sheet, or create a new sheet if the industry doesn't already exist; but we need to know the structure of the data. A sample would be good (see link in signature about how to display sheet on board). But you can explain it instead if you like.

What columns are each field in? What is the name of the master sheet? What row are your field names / column labels in? Are there any formulae in the master sheet?
 
Upvote 0
Jon von der Heyden said:
Hi Mike

Welcome to the board!

We could probably provide a worksheet_change event macro that will move entries to the appropriate sheet, or create a new sheet if the industry doesn't already exist; but we need to know the structure of the data. A sample would be good (see link in signature about how to display sheet on board). But you can explain it instead if you like.

What columns are each field in? What is the name of the master sheet? What row are your field names / column labels in? Are there any formulae in the master sheet?
Click to expand...

Jon! Thank you so much for your response. The name of the 'Master Sheet' and at the moment there are no formulas in it.. any ideas? (I'm working on making this much better, that's why I am here I suppose). There are 29 columns, spanning from A to AC and the field names are in the first row.

Here is a list of all the labels:(first one being A all the way to AC)
<TABLE style="WIDTH: 1735pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=2312 border=0 x:str><COLGROUP><COL style="WIDTH: 263pt; mso-width-source: userset; mso-width-alt: 12800" width=350><COL style="WIDTH: 48pt" span=6 width=64><COL style="WIDTH: 58pt; mso-width-source: userset; mso-width-alt: 2816" width=77><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 135pt; mso-width-source: userset; mso-width-alt: 6582" width=180><COL style="WIDTH: 49pt; mso-width-source: userset; mso-width-alt: 2377" width=65><COL style="WIDTH: 48pt; mso-width-source: userset; mso-width-alt: 2340" span=10 width=64><COL style="WIDTH: 78pt; mso-width-source: userset; mso-width-alt: 3803" width=104><COL style="WIDTH: 48pt; mso-width-source: userset; mso-width-alt: 2340" span=7 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black 0.5pt solid; WIDTH: 263pt; BORDER-BOTTOM: black 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: silver" width=350 height=17>Company</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>EmployeeNumber</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>SwitchBoard1</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Title</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Surname</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Name</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>JobTitle</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 58pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=77>Department</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Email</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 135pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=180>HandPhone</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 49pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=65>Website</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>SwitchBoard2</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Fax</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Fax2</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Address1</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Address2</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Address3</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Address4</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>ZipCode</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>City</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>State</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 78pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=104>Country</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Business</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>RegionCovered</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Description</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>TargetMkt</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Notes</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Source</TD><TD class=xl25 style="BORDER-RIGHT: black 0.5pt solid; BORDER-TOP: black 0.5pt solid; BORDER-LEFT: black; WIDTH: 48pt; BORDER-BOTTOM: black 0.5pt solid; BACKGROUND-COLOR: silver" width=64>Address</TD></TR></TBODY></TABLE>

I want to sort it by Business, which is column W. Is it important to know the categories for this?

I took Excel classes in HS, and I made macros before, but I haven't done stuff like this for 5 years..

Thanks in Advance for any ideas/help!!
 
Upvote 0
Hi again Mike

Right-click your master sheet tab and click on 'View Code'.
The VBE will open. Copy the code below and paste into the code pane (main pane).
Close the VBE again.

Code: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim strShtName As String
 
    If Not Target.Column = 8 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    
    On Error GoTo NewDept
    
    strShtName = Target.Text
    
    If Not Sheets(strShtName) Is Nothing Then
        With Target.EntireRow
            .Copy _
                Sheets(strShtName).Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Delete
        End With
        Application.CutCopyMode = False
        Sheets(strShtName).Activate
        Exit Sub
    End If
        
NewDept:
    With Sheets.Add
        .Name = strShtName
        Target.Parent.Rows(1).Copy .Range("A1")
        Application.CutCopyMode = False
        With Target.EntireRow
            .Copy Sheets(strShtName).Range("A2")
            .Delete
        End With
        Application.CutCopyMode = False
    End With
 
End Sub

This is a change event and it will trigger each time you add the department too a record. It will move the new entry to the relevant sheet or create a new sheet for the department if it doesn't already exist. Then it will allow the user to complete the entry in that sheet.

Hope this helps.
 
Upvote 0
Jon von der Heyden said:
Hi again Mike

Right-click your master sheet tab and click on 'View Code'.
The VBE will open. Copy the code below and paste into the code pane (main pane).
Close the VBE again.

Code: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim strShtName As String
 
    If Not Target.Column = 8 Then Exit Sub
    If Target.Count > 1 Then Exit Sub
 
    On Error GoTo NewDept
 
    strShtName = Target.Text
 
    If Not Sheets(strShtName) Is Nothing Then
        With Target.EntireRow
            .Copy _
                Sheets(strShtName).Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Delete
        End With
        Application.CutCopyMode = False
        Sheets(strShtName).Activate
        Exit Sub
    End If
 
NewDept:
    With Sheets.Add
        .Name = strShtName
        Target.Parent.Rows(1).Copy .Range("A1")
        Application.CutCopyMode = False
        With Target.EntireRow
            .Copy Sheets(strShtName).Range("A2")
            .Delete
        End With
        Application.CutCopyMode = False
    End With
 
End Sub

This is a change event and it will trigger each time you add the department too a record. It will move the new entry to the relevant sheet or create a new sheet for the department if it doesn't already exist. Then it will allow the user to complete the entry in that sheet.

Hope this helps.
Click to expand...

One Question Jon, Do I need to have all the other sheets renamed, right now they are just sheet 2 sheet 3, etc..

Thanks a million!
 
Upvote 0
Hi again Mikey

Here is a macro to copy all of your existing data to new sheets for each department. Firstly delete the existing department sheets (do NOT delete the master sheet).

Open the VBE (ALT+F11) and go Insert > Module.
Copy the code below and paste it into the code pane for the new module.

Code: 
Option Explicit
 
Sub CopyExistingData()
 
    Dim arrDEPARTMENTS()
    Dim rngDATA As Range, rngCELL As Range
    Dim lngLASTROW As Long, lngITEM As Long
    
    With Sheets("Master Sheet")
        lngLASTROW = .Range("A" & Rows.Count).End(xlUp).Row
        lngITEM = -1
        Set rngDATA = .Range("A1:AC" & lngLASTROW)
        For Each rngCELL In .Range("H2:H" & lngLASTROW)
            If Application.CountIf(.Range(.Range("H2"), rngCELL), rngCELL.Value) = 1 Then
                lngITEM = lngITEM + 1
                ReDim Preserve arrDEPARTMENTS(lngITEM)
                arrDEPARTMENTS(lngITEM) = rngCELL.Value
            End If
        Next rngCELL
    End With
    
    For lngITEM = LBound(arrDEPARTMENTS) To UBound(arrDEPARTMENTS)
        With Sheets.Add
            .Name = arrDEPARTMENTS(lngITEM)
            With rngDATA
                .Parent.AutoFilterMode = False
                .AutoFilter field:=8, Criteria1:=arrDEPARTMENTS(lngITEM)
                .SpecialCells(xlCellTypeVisible).Copy
            End With
            .Range("A1").PasteSpecial
            Application.CutCopyMode = False
        End With
    Next lngITEM
    
    Set rngDATA = Nothing
    Set rngCELL = Nothing
End Sub

Close the VBE and go to 'Master Sheet'. Hit ALT+F8 and run the macro called 'CopyExistingData'.

This should create a new sheet for each department and the data belonging to each should have been copied to this new sheet. Validate that it has correctly copied, and if it has return to the Master Sheet and delete the data.

From now on the change event macro should automatically force entries to the appropriate sheet.
 
Upvote 0
Okay, that was a dumb question.. lol. It's working, but I have a couple other questions. It's not automatically sorting.. do I have to go back and re-enter the department in each contact? Or should it automatically sort? When I enter a label in the department column, it does sort, so that works.. Is there somethign I am missing?

You're the man.
 
Upvote 0
Jon von der Heyden said:
Hi again Mikey

Here is a macro to copy all of your existing data to new sheets for each department. Firstly delete the existing department sheets (do NOT delete the master sheet).

Open the VBE (ALT+F11) and go Insert > Module.
Copy the code below and paste it into the code pane for the new module.

Code: 
Option Explicit
 
Sub CopyExistingData()
 
    Dim arrDEPARTMENTS()
    Dim rngDATA As Range, rngCELL As Range
    Dim lngLASTROW As Long, lngITEM As Long
    
    With Sheets("Master Sheet")
        lngLASTROW = .Range("A" & Rows.Count).End(xlUp).Row
        lngITEM = -1
        Set rngDATA = .Range("A1:AC" & lngLASTROW)
        For Each rngCELL In .Range("H2:H" & lngLASTROW)
            If Application.CountIf(.Range(.Range("H2"), rngCELL), rngCELL.Value) = 1 Then
                lngITEM = lngITEM + 1
                ReDim Preserve arrDEPARTMENTS(lngITEM)
                arrDEPARTMENTS(lngITEM) = rngCELL.Value
            End If
        Next rngCELL
    End With
    
    For lngITEM = LBound(arrDEPARTMENTS) To UBound(arrDEPARTMENTS)
        With Sheets.Add
            .Name = arrDEPARTMENTS(lngITEM)
            With rngDATA
                .Parent.AutoFilterMode = False
                .AutoFilter field:=8, Criteria1:=arrDEPARTMENTS(lngITEM)
                .SpecialCells(xlCellTypeVisible).Copy
            End With
            .Range("A1").PasteSpecial
            Application.CutCopyMode = False
        End With
    Next lngITEM
    
    Set rngDATA = Nothing
    Set rngCELL = Nothing
End Sub
Close the VBE and go to 'Master Sheet'. Hit ALT+F8 and run the macro called 'CopyExistingData'.

This should create a new sheet for each department and the data belonging to each should have been copied to this new sheet. Validate that it has correctly copied, and if it has return to the Master Sheet and delete the data.

From now on the change event macro should automatically force entries to the appropriate sheet.
Click to expand...

Hi Jon,

Again, thank you so much for all of your help! I just am having one little problem.

I got this error message: Runtime Error '1004' While renaming chart you entered an invalid name.

When I go to 'Debug' it has this highlighted in yello .Name = arrDEPARTMENTS(lngITEM)

As an FYI, I Might have caused the problem, because I moved the Industry row right before the department Row, because I actually wanted to sort it by Industry, not department, and I thought this would work (It worked before for the first Macro you posted.) The "CopyExistingData' VB did sort a lot of it, but then I got that error message.

Any ideas? Again thank you so much for your time, I really appreciate it!
 
Upvote 0
Hey Mike

I suspect that you have an Industry that would be an invalid name for a sheet. Try the code below, which will skip the error and therefore will not rename the sheet. Then look for sheets that haven't been names (e.g. Sheet5), and then manually rename it.

Code: 
Option Explicit

Sub CopyExistingData()

    Dim arrDEPARTMENTS()
    Dim rngDATA As Range, rngCELL As Range
    Dim lngLASTROW As Long, lngITEM As Long
    
    With Sheets("Master Sheet")
        lngLASTROW = .Range("A" & Rows.Count).End(xlUp).Row
        lngITEM = -1
        Set rngDATA = .Range("A1:AC" & lngLASTROW)
        For Each rngCELL In .Range("H2:H" & lngLASTROW)
            If Application.CountIf(.Range(.Range("H2"), rngCELL), rngCELL.Value) = 1 Then
                lngITEM = lngITEM + 1
                ReDim Preserve arrDEPARTMENTS(lngITEM)
                arrDEPARTMENTS(lngITEM) = rngCELL.Value
            End If
        Next rngCELL
    End With
    
    For lngITEM = LBound(arrDEPARTMENTS) To UBound(arrDEPARTMENTS)
        With Sheets.Add
            On Error Resume Next
                .Name = arrDEPARTMENTS(lngITEM)
            On Error GoTo 0
            With rngDATA
                .Parent.AutoFilterMode = False
                .AutoFilter field:=8, Criteria1:=arrDEPARTMENTS(lngITEM)
                .SpecialCells(xlCellTypeVisible).Copy
            End With
            .Range("A1").PasteSpecial
            Application.CutCopyMode = False
        End With
    Next lngITEM
    
    Set rngDATA = Nothing
    Set rngCELL = Nothing
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
Need help with organizing processes to proceed. Project / Challenge.
Replies
3
Views
450
noveske
N
K
  • Question Question
Need to create/source a macro/vba/program that auto populates info based on matching word criteria for community support agency
Replies
3
Views
709
Micron
M
G
  • Solved
How to filter a table with two email columns against a list of emails
Replies
7
Views
667
dreid1011
dreid1011
H
  • Question Question
Match and sort different sized data sets
Replies
8
Views
725
Hammer123
H
S
  • Solved
Lookup on Merged Cells and Multiple Columns Below
Replies
8
Views
793
Saacko
S

Forum statistics

Threads
1,223,237
Messages
6,170,924
Members
452,366
Latest member
TePunaBloke

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top