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

x
?
Solved

Help with Excel formula and/or script copying data to new sheets.

Posted on 2015-01-30
5
Medium Priority
?
94 Views
Last Modified: 2015-02-04
I have sheet named “RawCarData”.   It contains records; 10 columns, one column is a CompanyID that can be “Ford”, “Chevy”, “Honda”, etc.

I need to create additional sheets, one for each unique CompanyID, named “Ford”, “Chevy”, “Honda”, etc.  I need to the copy the data from the “RawCarData” to these new sheets based on the CompanyID.  I hope this makes sense.

Is there a way to do this using formulas or some Excel script?
0
Comment
Question by:HLRosenberger
[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
5 Comments
 
LVL 24

Assisted Solution

by:Phillip Burton
Phillip Burton earned 500 total points
ID: 40579747
Assuming the data for CompanyID starts in row 2, column 1, then try this:

Sub AddSheets()
Set currentsheet = ActiveSheet
introw = 2
Do Until Cells(introw, 1) = ""
    ActiveWorkbook.Sheets.Add
    ActiveSheet.Name = currentsheet.Cells(introw, 1)
    currentsheet.Activate
    introw = introw + 1
Loop
End Sub

Open in new window

0
 
LVL 18

Accepted Solution

by:
Simon earned 1000 total points
ID: 40579792
If you create a pivot table (Insert/Pivot Table) and put CompanyID in the Rows area...

You can then use this macro to split it into individual sheets, each containing all the rows of data for one make.
Sub PivotTable_GenerateWkShtPerLine()
Const msgTitle As String = "Pivot table burster"
Dim continue As Variant
Dim pivotSht As Worksheet

Dim pt As String
Dim titlesRange As Range
Dim shtTitlesRange As Range
Dim titlePrefix As String
Dim titleSuffix As String
Dim shtName As String
Dim fitToOnePageWide_999Tall As Boolean

continue = MsgBox("This creates one sheet for each selected row in the pivot table, named according to the column(s) you choose." & vbCrLf & "For best results, ensure you have sorted the base data and set the default table style before running this.", vbOKCancel + vbInformation, msgTitle)
If continue <> vbOK Then Exit Sub Else

Set pivotSht = ActiveSheet
'Test whether the selection is part of a pivot table.
On Error Resume Next
pt = ActiveSheet.Range(Selection.Address).PivotTable.Name
If Err.Number <> 0 Then
    MsgBox "The selected range (" & Selection.Address & ") is not part of a pivot table!", , msgTitle
    Exit Sub
End If
On Error GoTo 0

If Selection.Cells.Count < 2 Then
    If MsgBox("Select a range of cells (usually the totals) for which to show details (by generating a new sheet per pivot row)", vbOKCancel, msgTitle) <> vbOK Then
        Exit Sub
    End If
End If

'Prompt user to select the columns from which to generate sheet names
On Error Resume Next
Set titlesRange = Application.InputBox("Which columns have the data that will form the worksheet names?", msgTitle, , , , , , 8)
If Err.Number <> 0 Then Exit Sub Else
On Error GoTo 0
Debug.Print "Titles from range: " & titlesRange.Address

On Error Resume Next
titlePrefix = Application.InputBox("Add a prefix to the worksheet names if desired", msgTitle, , , , , , 2)
If Err.Number <> 0 Then Exit Sub Else
On Error GoTo 0
Debug.Print "Title prefix string: " & titlePrefix

On Error Resume Next
titleSuffix = Application.InputBox("Add a suffix to the worksheet names if desired", msgTitle, , , , , , 2)
If Err.Number <> 0 Then Exit Sub Else
On Error GoTo 0
Debug.Print "Title suffix string: " & titleSuffix

'
'If MsgBox("Fit result sheets to one landscape page wide?", vbQuestion + vbYesNo, msgTitle) = vbYes Then
'fitToOnePageWide_999Tall = True
'End If


'*** Main Loop ***
Dim c As Variant
Dim i As Variant
For Each c In Selection
    Debug.Print Intersect(titlesRange, Rows(c.Row)).Address
    Set shtTitlesRange = Intersect(titlesRange, Rows(c.Row))
    shtName = ""
    For Each i In shtTitlesRange
        If shtName = "" Then
            shtName = i
        Else
            shtName = shtName & "_" & i
        End If
    Next
    shtName = titlePrefix & shtName & titleSuffix
    shtName = Left(shtName, 31)
    c.ShowDetail = True 'This creates a new worksheet for the pivot table item's detail lines
    ActiveSheet.Name = shtName
    
    
    If fitToOnePageWide_999Tall Then
        Call PageSetup_FitToOnePageWideBy999Tall
    End If
    ActiveSheet.Cells(2, 1).Select
    'Turn off autofilter to make sheet autofit columns more tightly
    Selection.AutoFilter 'This relies on the fact that the result sheet are initially autofiltered (so this command turns the filter OFF)
    ActiveSheet.Columns.AutoFit
    ActiveWindow.FreezePanes = True
    ActiveSheet.Cells(1, 1).Select 'Leave sheet with cell A1 selected
    'switch focus back to pivot sheet, so that intersect statement works.
    pivotSht.Activate
Next
End Sub

Open in new window


See also this previously answered question: http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28577286.html
0
 
LVL 33

Assisted Solution

by:Rob Henson
Rob Henson earned 500 total points
ID: 40580000
Alternative to Simon's suggestion with a Pivot Table, use the Company ID as a Page Value, rather than in Row values, then the report is just for that Company.

You can then just use only one report sheet but change the Page Reference as required.

You could also use the Advanced Filter function to filter data and copy to another location if you do want multiple sheets.

Thanks
Rob H
0
 
LVL 18

Assisted Solution

by:Simon
Simon earned 1000 total points
ID: 40580298
I should have mentioned that I have a different variant of my code to break the pivoted data into separate workbooks (e.g. one per CompanyID) if that's required.
0
 
LVL 1

Author Closing Comment

by:HLRosenberger
ID: 40589691
thanks to all.
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

Question has a verified solution.

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

We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
Microsoft has changed the look and feel of Azure AD and Microsoft account sign-in pages so that you will have a more unified look and feel when moving between the two interfaces.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

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