Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

create new worksheets and populate data

Posted on 2014-04-09
7
Medium Priority
?
308 Views
Last Modified: 2014-06-17
Hi.  I have a spreadsheet with 1 worksheet full of customer data:  Acct No, name, address, phone, fax, etc and 1 column marked territory (north, south, central, etc...) and 1 column with the regional sales manager initials (manager for account).
Rather than take the time to create a database and move this data in I was wondering if it would be possible to grab the data in worksheet 1 and create and name a worksheet for each of my sales managers.   Worksheet1= Customer Listing, new worksheet2 = Manager1, new worksheet3 = Manager2, etc..  along with that I also want to add a heading in row 1 and add soem very basic column formatting to the new worksheet on create.  I'm thinking some sort of macro to do all of this but not sure...

Ultimately,  I want my managers to go to their section on Worksheet1, find the customer they want to update, click on it (hyperlink to corresponding sheet) and fill in call log data for visits, calls, emails, project updates, etc...)  data would be column 1= date and column 2 = call history.  Manual entry for each new call logged at that point...

thanks
0
Comment
Question by:valmatic
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
7 Comments
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39989360
You asked several questions. Let's deal with the first one: Split data into multiple worksheets based on column.

Here you will find some code to accomplish that:
Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 1
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:C1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
        On Error Resume Next
        If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
            ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
        End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
        Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
End Sub

Open in new window



vcol =1, the number 1 is the column number that you want to split the data based on.
Set ws = Sheets("Sheet1"), Sheet1 is the sheet name that you want to apply this code.
title = "A1:C1", A1:C1 is the range of the title.

All of them are variables, you can change them as your need.
0
 
LVL 7

Author Comment

by:valmatic
ID: 39992237
many thanks for that...  I tweaked it a little and got most of the way there.  I actually switched it up and separated each manager and their customers into their own spreadsheet and use the the 2nd column (customer name)  to title each new tab.  Lastly I'm calling another sub within the the new tab loop to add formatting to each new worksheet.  Pretty sweet..  

The only thing I need to do now is make each row of data (columnB) on sheet1 a hyperlink to open the corresponding tab that was just created.  Can we incorporate this into your code?  Not really sure how to get code to create a hyperlink to loop for each customer on sheet 1 though.   Let me know if I should create a separate question for this part.  
Range("B2").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
        "'MUNICIPAL EQUIPMENT'!A1", TextToDisplay:="MUNICIPAL EQUIPMENT"

Open in new window


Here is the change I made to your code:
Sub CreateCallLog2()
'
' CreateCallLog2 Macro
' Create multiple sheets based on data
'

'
'Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 2
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:B1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
        On Error Resume Next
        If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
            ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
        End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
        Sheets(myarr(i) & "").Columns.AutoFit
        
    Call CreateCallLog1  'Formatting on new worksheets
    
    Next
    ws.AutoFilterMode = False
    ws.Activate
End Sub

Open in new window

0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39996709
Add the following line at the end of the second loop:
ws.Hyperlinks.Add Anchor:=ws.Cells(i, vcol), Address:="", SubAddress:=myarr(i) & "!B1", TextToDisplay:=""

Open in new window

0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 7

Author Comment

by:valmatic
ID: 40017937
Hi,  I'm so sorry I took so long to respond.  
I tried the additonal code and the hyperlink are created on sheet 1 but point back to sheet 1 cell A1.  Would it have to do with code placement?  I added at end of 2nd loop, here:
For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
    ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
    Sheets(myarr(i) & "").Columns.AutoFit

ws.Hyperlinks.Add Anchor:=ws.Cells(i, vcol), Address:="", SubAddress:=myarr(i) & "!B1", TextToDisplay:="" 'add links on sheet1

    Call CreateCallLog1  'Formatting on new worksheets
    
    Next
    ws.AutoFilterMode = False
    ws.Activate
    
    Call CreateCallLog  'Formatting for Sheet1

Open in new window

0
 
LVL 27

Accepted Solution

by:
MacroShadow earned 2000 total points
ID: 40018269
Sorry, this is the right line:
ws.Hyperlinks.Add Anchor:=ws.Cells(i, vcol), Address:="", SubAddress:="'" & myarr(i) & "'" & "!B1", TextToDisplay:=ws.Cells(i, vcol).Value

Open in new window

0
 
LVL 7

Author Comment

by:valmatic
ID: 40105433
thanks
0
 
LVL 7

Author Closing Comment

by:valmatic
ID: 40140228
I apologize.  I had to refocus elsewhere and lost track of this case.  Please take the points and I'll post a new question if needed.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

636 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question