MS Excel Question

From a big CSV file, I've to extract expertise of people, residing under Title header, e.g,, need to copy all PHP folks into another sheet and same for other expertise too, like Designers to another sheet and so on and so forth.

Headers are First Name, Last Name, Email & Title.

Please do assist here, thanks in advance.
Mushfique KhanDirector OperationsAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Steven HarrisPresidentCommented:
Can you upload a sample file for us to work with?
0
Mushfique KhanDirector OperationsAuthor Commented:
uploaded, need to segregate people on the basis of their expertise.
test.csv
0
Zack BarresseCEOCommented:
Can you be a little more specific? Where should this data go exactly? If an existing location, should it overwrite everything in the destination? Also, what version of Excel are you using? Will this file be open already, or do you want to choose it from a file dialog picker, or does it reside somewhere you already know? Please give as many details as possible.

Regards,
Zack Barresse
0
10 Tips to Protect Your Business from Ransomware

Did you know that ransomware is the most widespread, destructive malware in the world today? It accounts for 39% of all security breaches, with ransomware gangsters projected to make $11.5B in profits from online extortion by 2019.

ButlerTechnologyCommented:
Here's a possible solution -- I could imagine that it could break in several areas.

Step 1: Duplicate the Sheet with the data to individual sheets based on the title Name.  This could easily fail if the title breaks any rules for naming of a worksheet.

Private Sub TitleSheets()
Dim SheetTitle As String
Dim wSheet As Worksheet
Dim SheetExists As Boolean

' Make sure we are in A2
  Range("A2").Activate
    
' Loop Thu List
  Do
    SheetTitle = ActiveCell.Offset(0, 3).Value
    SheetExists = False
  For Each wSheet In Worksheets
    If SheetTitle = wSheet.Name Then SheetExists = True
  Next
  If SheetExists = False Then
    Worksheets("Original").Copy Sheets(Sheets.Count)
    ActiveSheet.Name = SheetTitle
  End If
  ActiveCell.Offset(1, 0).Activate
  Loop Until ActiveCell.Value = ""
End Sub

Open in new window


Step 2: Loop Though the Worksheet collection and remove any rows that don't match the title of the sheet.  We will ignore the original sheet.

Private Sub CleanUpList()
Dim Title As String
Dim wSheet As Worksheet

For Each wSheet In Worksheets
If wSheet.Name <> "Original" Then
  wSheet.Activate
  Title = ActiveSheet.Name
  Range("A2").Activate
  Do
    If ActiveCell.Offset(0, 3) = Title Then
      ActiveCell.Offset(1, 0).Activate
    Else
      ActiveCell.EntireRow.Delete
    End If
  Loop Until ActiveCell.Value = ""
  Range("A1").Activate
End If
Next
End Sub

Open in new window


Step 3: Create a public routine that call the two private routines.

Public Sub CreateTitleSheets()
TitleSheets
CleanUpList
End Sub

Open in new window


The code could use some serious cleanup and a few key functions that would make it more readable.

Tom
0
Mushfique KhanDirector OperationsAuthor Commented:
firefytr ... task is to segregate on the basis of expertise ... that's it, enable us to contact them accordingly, otherwise will be a spam for others ... is this clear, now how you would like to do this task ... up to you ... we are only interested in the bottom-line; people divided/segregated on the basis of their title/expertise.

Please check the attachment, this is a CSV file.
0
Zack BarresseCEOCommented:
Hmm, I'm not sure you understood me. I can do this all day in my sleep, but unless you tell us exactly what you need I'm just shooting in the dark here, so it may not be what you want. Also, I don't understand why it would mean spam for others. Depending on what you're doing, there may be a better way to get it done with your requirements. I can't tell you how because I don't know what you're doing. The more specific you are, the better solution and detailed response you're going to get.

This routine will do what you want I think...

Sub SegregateByTitle()

    Dim WS As Worksheet
    Dim TitleSheet As Worksheet
    Dim colTitles As New Collection
    Dim rData As Range
    Dim rBody As Range
    Dim iStep As Long
    Dim aData() As Variant
    Dim vKey As Variant
    
    Call TOGGLEEVENTS(False)
    
    Set WS = ActiveSheet 'assumes you will hav the whole list active first
    Set rData = WS.Range("A1", WS.Cells(WS.Rows.Count, "E").End(xlUp))
    Set rBody = WS.Range("A2", WS.Cells(WS.Rows.Count, "E").End(xlUp))
    Let aData = Intersect(rBody, WS.Range("D:D")).Value
    
    For iStep = LBound(aData) To UBound(aData)
        If KEYISINCOLLECTION(colTitles, CStr(aData(iStep, 1))) = False Then
            colTitles.Add aData(iStep, 1), aData(iStep, 1)
        End If
    Next iStep
    
    For Each vKey In colTitles
        If WSEXISTS(vKey, ThisWorkbook) = False Then
            Set TitleSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            TitleSheet.Name = vKey
        Else
            Set TitleSheet = ThisWorkbook.Worksheets(vKey)
            TitleSheet.Cells.Clear
        End If
        rData.AutoFilter 4, vKey
        rData.SpecialCells(xlCellTypeVisible).Copy TitleSheet.Range("A1")
        rData.AutoFilter
    Next vKey
    
    Call TOGGLEEVENTS(True)
    MsgBox "Process complete!", vbExclamation, "DONE!"
    
End Sub

Public Function KEYISINCOLLECTION(colTemp As Collection, sTempKey As String) As Boolean
    Dim vTemp                   As Variant
    KEYISINCOLLECTION = False
    On Error GoTo NotInCollection
    vTemp = colTemp(sTempKey)
    KEYISINCOLLECTION = True
NotInCollection:
    On Error GoTo 0
End Function

Function WSEXISTS(ByVal wksName As String, Optional WKB As Workbook) As Boolean
    If WKB Is Nothing Then
        If ActiveWorkbook Is Nothing Then Exit Function
        Set WKB = ActiveWorkbook
    End If
    On Error Resume Next
    WSEXISTS = CBool(Len(WKB.Worksheets(wksName).Name) <> 0)
    On Error GoTo 0
End Function

Sub TOGGLEEVENTS(blnState As Boolean)
    'Originally written by Zack Barresse
    Application.DisplayAlerts = blnState
    Application.EnableEvents = blnState
    Application.ScreenUpdating = blnState
    If blnState Then Application.CutCopyMode = False
    If blnState Then Application.StatusBar = False
End Sub

Open in new window


HTH

Zack
0
Mushfique KhanDirector OperationsAuthor Commented:
Sorry for this Zack, if I couldn't clarify, let's try one more time:

You can see my excel sheet (test.csv), has 4 columns, attached is what we are trying to do, please have a look and update ... whatever best way to achieve this, just did for 3 titles only.

Do update, if still it's not good ... :-(
test2.xlsx
0
Zack BarresseCEOCommented:
I see 5 columns.

First
Last
Email
Title
Company

I'm not sure what you want here. The code I posted will take each unique Title (from column D) and put it on it's own sheet, creating it if it's not already. This gives you a 'segregation' to different worksheets, just as you asked.

If you tried the code and it doesn't work for you, or doesn't give the desired results, please post back what you do want. Be as explicit and succinct as possible. :)

Zack
0
tel2Commented:
Hi mkhandba,

Please provide sample expected output for the sample input you've provided.

And I suggest you do this wherever appropriate, when raising questions in future, in your original post, so experts can see exactly what you're after, and they can test their solutions against your input/output data to see if they work before they post answers.  A bit of extra time spent up front, can save a lot later.
A "picture's" worth a thousand words.

Thanks.
tel2
0
tel2Commented:
Sorry mkhandba - looks as if you may have pre-empted my last post, by 8 mins.
0
Mushfique KhanDirector OperationsAuthor Commented:
But Zack, can you tell me how to write/code this code in excel, where to write this :-( have no idea, never did this.
0
Zack BarresseCEOCommented:
Sure. It goes into a standard module. You'll need to go into the Visual Basic Editor (VBE) first. To get there hit ALT + F11. If you have the developer tab showing (doesn't show by default, right-click the ribbon and customize to check it) you can click the Visual Basic button.

Hit CTRL + R to show the Project Explorer (if not already showing). Find your project (aka workbook). There are a few ways to insert a standard module. Either right-click the project and select Insert, Module, or with it the active project go to the Insert menu. Paste the code in there. Put your cursor in the 'SegregateByTitle' routine and press F5 to run it.

HTH
Zack
0
Mushfique KhanDirector OperationsAuthor Commented:
thanks Zack ... let me try, will get back in a while :-)
0
Mushfique KhanDirector OperationsAuthor Commented:
Here are the steps:
1. Alt+F11
2. Ctl+R  ~~> shows my sheet
3. on my sheet, Right Click ~> Insert ~> Module
4. Copy/paste this complete code: Sub SegregateByTitle() ... to ... End Sub
5. place the cursor on SegregateByTitle() ... and press F5
6. got this error ... attached

What I'm doing wrong here ... :-(
error.JPG
0
Zack BarresseCEOCommented:
Looks like you may have values in the unique list which aren't legal for sheet names. That's my fault. I assumed you would have all words and no illegal (worksheet name) characters.

There are 3 checks you need to do...
1) Leading/trailing spaces
2) Illegal characters
3) Name length.

You didn't say what line was highlighted when you clicked the Debug button in that error message, but I bet you $1 it's on this line...

TitleSheet.Name = vKey

Open in new window


Here are some links to look at for checking/removing illegal worksheet name characters...
http://www.vbaexpress.com/kb/getarticle.php?kb_id=778
http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_28025657.html (same principal)
http://stackoverflow.com/questions/451452/valid-characters-for-excel-sheet-names

I would look at changing the above line to include these as well...

    Dim BadChars                As String
    Dim vKeyTemp                As String
    Dim iStep                   As Long
    BadChars = ":\/?*[]"
    vKeyTemp = Left(Trim(vKey), 31)
    For iStep = 1 To Len(BadChars)
        vKeyTemp = Replace(vKeyTemp, Mid(BadChars, iStep, 1), "")
    Next iStep
    TitleSheet.Name = vKeyTemp

Open in new window


I'd move the Dim statements up top with the others to keep it clean.

One thing this won't do is then test if the worksheet name already exists. To do so you would just do the check at the start of that iteration, like so...

    Dim BadChars                As String
    Dim vKeyTemp                As String
    Dim iStep                   As Long

    BadChars = ":\/?*[]"

    For Each vKey In colTitles
        vKeyTemp = Left(Trim(vKey), 31)
        For iStep = 1 To Len(BadChars)
            vKeyTemp = Replace(vKeyTemp, Mid(BadChars, iStep, 1), "")
        Next iStep
        If WSEXISTS(vKeyTemp, ThisWorkbook) = False Then
            Set TitleSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            TitleSheet.Name = vKeyTemp
        Else
            Set TitleSheet = ThisWorkbook.Worksheets(vKey)
            TitleSheet.Cells.Clear
        End If
        rData.AutoFilter 4, vKey
        rData.SpecialCells(xlCellTypeVisible).Copy TitleSheet.Range("A1")
        rData.AutoFilter
    Next vKey

Open in new window


Again, I'd put the Dim statements up top.

HTH
Zack
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Mushfique KhanDirector OperationsAuthor Commented:
would like to test this ... thanks Zack and sorry for the delay.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.