Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 124
  • Last Modified:

How to do this in Microsoft Excel

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
Judy Deo
Asked:
Judy Deo
  • 7
  • 3
  • 3
  • +2
2 Solutions
 
Roy CoxGroup Finance ManagerCommented:
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
 
Judy DeoAuthor Commented:
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
 
Rob HensonIT & Database AssistantCommented:
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
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!

 
Roy CoxGroup Finance ManagerCommented:
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
 
Judy DeoAuthor Commented:
Sorry, thought I uploaded the sample workbook file on the initial post! See attached.
VBA_Excel_-Test_File.xlsm
0
 
byundtCommented:
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
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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
 
byundtCommented:
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
 
Judy DeoAuthor Commented:
Hi All, thanks for giving feedback so quickly. Reviewing this shortly!
0
 
Roy CoxGroup Finance ManagerCommented:
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
 
Judy DeoAuthor Commented:
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
 
Judy DeoAuthor Commented:
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
 
Judy DeoAuthor Commented:
thank you so much. this site is awesome. you guys are awesome.
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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
 
Judy DeoAuthor Commented:
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
 
byundtCommented:
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 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.

  • 7
  • 3
  • 3
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now