Solved

How to do this in Microsoft Excel

Posted on 2016-09-25
16
88 Views
Last Modified: 2016-09-30
First Tab - Master customer data file. Tab Name = "MASTER"
Second Tab  - specific data for an individual customer. Tab Name = "13 n clark"

Goal: How do you automatically populate the 2nd tab from the data in the first tab with the knowledge that the values in the "ID SMK" column under each subgroup may change. Specifically meaning that under the "13 n clark" customer, "B2323" may be under a different customer the next month AND there may be more or less ID SMK's underneath "13 n Clark" the next month as well.
0
Comment
Question by:sagardeo
  • 7
  • 3
  • 3
  • +2
16 Comments
 
LVL 17

Expert Comment

by:Roy_Cox
ID: 41814893
You should keep all the data on one master sheet then create customer view sheet using VLOOKUPs. You do not want sheets for individual customers.

Here's a very quick example. There's lots more that you can do with PivotTable, etc. The key is to keep all data in one sheet
Customers.xlsx
0
 

Author Comment

by:sagardeo
ID: 41814909
But that's the thing, we NEED there to be individual sheets since they are being sent to the customer. The logic we are going for is the following.

1. Create new worksheet within the existing workbook and title it with the value that is the row that begins with "Customer : ". This seems to be the code needed to programmatically create this worksheet (https://msdn.microsoft.com/en-us/library/6fczc37s.aspx)
2. Add same columns that are in the "Master" sheet to the above referenced programmatically created worksheet.
3. Copy values in rows underneath cell with above referenced "Customer : " until you hit another cell with "Customer : ".
4. Fill in corresponding values in associated columns
5. Loop/do the same steps above but each time programatically creating a new worksheet.

Again, we get that it would be better if there was all in one sheet. But the subsequent programatically created sheets are designed to send to customers.
0
 
LVL 31

Expert Comment

by:Rob Henson
ID: 41815565
As Roy mentioned you can do something similar with Pivot Tables.

Can you upload a sample set of data?

In the meantime, if you already know how to, create a pivot table and use the Customer Reference as a Page filter. With the cursor in the Pivot Table there will be an extra tab on the ribbon for Design and Layout. On one of those at the far left there is a button for Pivot Table options. Next to this is a dropdown and under the Dropdown there is an option for creating Page Reports. Click this and it will give an option for creating pages (tabs) from each Page Filter and each tab will be named as the Customer filter. These Pivots will still be linked to the master data so before sending to customers it is probably worth copying and pasting as values. Otherwise the receiving customer may be able to remove the page filter and refresh to show all details.
0
 
LVL 17

Expert Comment

by:Roy_Cox
ID: 41816437
As Rob has pointed out, it's difficult to advise without seeing an example workbook. It doesn't need much data and you can use dummy names.
0
 

Author Comment

by:sagardeo
ID: 41816611
Sorry, thought I uploaded the sample workbook file on the initial post! See attached.
VBA_Excel_-Test_File.xlsm
0
 
LVL 80

Expert Comment

by:byundt
ID: 41816676
Here is a macro to create the new worksheets and copy the values over.
Sub UpdateSheets()
Dim ws As Worksheet
Dim cel As Range, rgData As Range, rgHeaders As Range, Total As Range
Dim i As Long, n As Long
With Worksheets("Master")
    Set rgData = .Range("A2")
    Set rgData = Range(rgData, .Cells(.Rows.Count, rgData.Column).End(xlUp))
    Set rgData = Intersect(rgData.EntireRow, .UsedRange)
    Set rgHeaders = rgData.EntireColumn.Rows(1)
End With
n = rgData.Rows.Count

For i = 1 To n
    If Left(rgData.Cells(i, 1).Value, 10) = "Customer :" Then
        Set Total = Nothing
        On Error Resume Next
        Set Total = rgData.Columns(1).Find("Customer Total", LookAt:=xlPart, MatchCase:=False, LookIn:=xlValues, after:=rgData.Cells(i, 1))
        If Not Total Is Nothing Then
            Set ws = Nothing
            Set ws = Worksheets(Mid(rgData.Cells(i, 1).Value, 12))
            If ws Is Nothing Then
                Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
                ws.Name = Mid(rgData.Cells(i, 1).Value, 12)
                rgHeaders.Copy ws.Range("A1")
            End If
            With ws
                Intersect(.UsedRange, .Range("2:1048576")).ClearContents
                Range(rgData.Cells(i, 1), Total.EntireRow.Cells(1, rgData.Columns.Count)).Copy
                .Range("A2").PasteSpecial xlPasteValues
            End With
        End If
        On Error GoTo 0
    End If
Next
End Sub

Open in new window

0
 
LVL 28

Assisted Solution

by:Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj) earned 50 total points
ID: 41816710
Another way to get the desired output on individual customer sheet is as below....

Sub PopulateIndividualCustomerSheet()
Dim sws As Worksheet, ws As Worksheet
Dim rng As Range
Dim shName As String
Dim lr As Long
Application.ScreenUpdating = False
Set sws = Sheets("Master")
For Each rng In sws.Range("B:B").SpecialCells(xlCellTypeConstants, 1).Areas
   shName = WorksheetFunction.Replace(rng.Cells(1).Offset(-1, -1).Value, 1, 11, "")
   On Error Resume Next
   Set ws = Sheets(shName)
   On Error GoTo 0
   If ws Is Nothing Then
      Sheets.Add(After:=Sheets(Sheets.Count)).Name = shName
      Set ws = ActiveSheet
      sws.Range("A1:M1").Copy ws.Range("A1")
   Else
      lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
      If lr > 1 Then ws.Range("A2:M" & lr).ClearContents
   End If
   rng.Cells(1).Offset(-1, -1).Resize(rng.Cells.Count + 2).Resize(, 13).Copy ws.Range("A2")
Next rng
Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 80

Accepted Solution

by:
byundt earned 450 total points
ID: 41816715
You had a little summary section, so I added code to create that as well.
Sub UpdateSheets()
Dim ws As Worksheet
Dim cel As Range, rgData As Range, rgHeaders As Range, Total As Range
Dim i As Long, n As Long, nRows As Long
Application.ScreenUpdating = False
With Worksheets("Master")
    Set rgData = .Range("A2")
    Set rgData = Range(rgData, .Cells(.Rows.Count, rgData.Column).End(xlUp))
    Set rgData = Intersect(rgData.EntireRow, .UsedRange)
    Set rgHeaders = rgData.EntireColumn.Rows(1)
End With
n = rgData.Rows.Count

For i = 1 To n
    Set cel = rgData.Cells(i, 1)
    If Left(cel.Value, 10) = "Customer :" Then
        Set Total = Nothing
        On Error Resume Next
        Set Total = rgData.Columns(1).Find("Customer Total", LookAt:=xlPart, MatchCase:=False, LookIn:=xlValues, after:=rgData.Cells(i, 1))
        If Not Total Is Nothing Then
            nRows = Total.Row - cel.Row + 1
            Set ws = Nothing
            Set ws = Worksheets(Mid(cel.Value, 12))
            If ws Is Nothing Then
                Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
                ws.Name = Mid(cel.Value, 12)
                rgHeaders.Copy ws.Range("A1")
            End If
            With ws
                Intersect(.UsedRange, .Range("2:1048576")).ClearContents
                rgData.Rows(i).Resize(nRows, rgData.Columns.Count).Copy
                .Range("A2").PasteSpecial xlPasteValues
                
                .Cells(nRows + 4, "F").Resize(7, 1).Value = Application.Transpose( _
                    Array("Total Supply", "Sales Cut", "Net", "", "Each", "Contract adjustment", "Final Rev"))
                .Cells(nRows + 4, "G").FormulaR1C1 = "=R[-3]C"
                .Cells(nRows + 5, "G").FormulaR1C1 = "=R[-4]C[5]"
                .Cells(nRows + 6, "G").FormulaR1C1 = "=R[-2]C-R[-1]C"
                .Cells(nRows + 8, "G").FormulaR1C1 = "=R[-2]C/2"
                .Cells(nRows + 10, "G").FormulaR1C1 = "=R[-2]C-R[-1]C"
            End With
        End If
        On Error GoTo 0

    End If
Next
End Sub

Open in new window

VBA_Excel_-Test_FileQ28972223.xlsm
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 

Author Comment

by:sagardeo
ID: 41816918
Hi All, thanks for giving feedback so quickly. Reviewing this shortly!
0
 
LVL 17

Expert Comment

by:Roy_Cox
ID: 41817187
If your data was stored as I suggested in one Table not separated as yours is the  sheets could be produced more easily, automating with VBA. Also, the proper format would be easier to maintain when adding data.
0
 

Author Comment

by:sagardeo
ID: 41818757
byundt, you are awesome! thank you so much. man i love this site. i used to use as a web developer years back. and now this is for my wife who is in accounting. this is literally going to save her a ton of manual work. can i hug you through the computer screen?
0
 

Author Comment

by:sagardeo
ID: 41818758
Subodh, thanks as well. I gave you as the assisted solution. only thing missing in yours is the loop required to created the additional sheets and the summary section.
0
 

Author Closing Comment

by:sagardeo
ID: 41818775
thank you so much. this site is awesome. you guys are awesome.
0
 
LVL 28

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41819026
You're welcome. Glad we couls help.
The code I offered should create a customer sheet if not available in the workbook, though I missed the summary portion.
0
 

Author Comment

by:sagardeo
ID: 41823953
I have a follow up question for the same problem. I'll create a new question and reference you both. Or can add in a new comment on this thread and then assign you a new set of points. Just want to keep it nice and clean for a subsequent user who might be having the same problem.

I'm changing the text "Customer :" to "Establishment :" and so looking for the specific line in the code that checks for it. It seems to be obvious that it was the line that has "If Left(cel.Value, 10) = "Customer :" but when I changed that to 15 and change the word "Customer" to "Establishment" it outputted the additional sheets but put in "Sheet1", "Sheet 2" , etc. for the sheet names instead of "13 n clark" etc.

Example: Customer : 13 n clark changing to Establishment : 13 n clark
0
 
LVL 80

Expert Comment

by:byundt
ID: 41823991
There should be three places where the code needs to be changed to reflect "Establishment :" instead of "Customer :". They are indicated in the code snippet below.

I changed the previous file to reflect Establishment : and the code ran fine.

Brad
Sub UpdateSheets()
Dim ws As Worksheet
Dim cel As Range, rgData As Range, rgHeaders As Range, Total As Range
Dim i As Long, n As Long, nRows As Long
Application.ScreenUpdating = False
With Worksheets("Master")
    Set rgData = .Range("A2")
    Set rgData = Range(rgData, .Cells(.Rows.Count, rgData.Column).End(xlUp))
    Set rgData = Intersect(rgData.EntireRow, .UsedRange)
    Set rgHeaders = rgData.EntireColumn.Rows(1)
End With
n = rgData.Rows.Count

For i = 1 To n
    Set cel = rgData.Cells(i, 1)
    'If Left(cel.Value, 10) = "Customer :" Then
    If Left(cel.Value, 15) = "Establishment :" Then
        Set Total = Nothing
        On Error Resume Next
        Set Total = rgData.Columns(1).Find("Customer Total", LookAt:=xlPart, MatchCase:=False, LookIn:=xlValues, after:=rgData.Cells(i, 1))
        If Not Total Is Nothing Then
            nRows = Total.Row - cel.Row + 1
            Set ws = Nothing
            'Set ws = Worksheets(Mid(cel.Value, 12))    'Customer :
            Set ws = Worksheets(Mid(cel.Value, 17))     'Establishment :
            If ws Is Nothing Then
                Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
                'ws.Name = Mid(cel.Value, 12)           'Customer :
                ws.Name = Mid(cel.Value, 17)            'Establishment :
                rgHeaders.Copy ws.Range("A1")
            End If
            With ws
                Intersect(.UsedRange, .Range("2:1048576")).ClearContents
                rgData.Rows(i).Resize(nRows, rgData.Columns.Count).Copy
                .Range("A2").PasteSpecial xlPasteValues
                
                .Cells(nRows + 4, "F").Resize(7, 1).Value = Application.Transpose( _
                    Array("Total Supply", "Sales Cut", "Net", "", "Each", "Contract adjustment", "Final Rev"))
                .Cells(nRows + 4, "G").FormulaR1C1 = "=R[-3]C"
                .Cells(nRows + 5, "G").FormulaR1C1 = "=R[-4]C[5]"
                .Cells(nRows + 6, "G").FormulaR1C1 = "=R[-2]C-R[-1]C"
                .Cells(nRows + 8, "G").FormulaR1C1 = "=R[-2]C/2"
                .Cells(nRows + 10, "G").FormulaR1C1 = "=R[-2]C-R[-1]C"
            End With
        End If
        On Error GoTo 0

    End If
Next
End Sub

Open in new window

VBA_Excel_-Test_FileQ28972223-Rev-1.xlsm
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

760 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

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now