0

I currently have a master excel sheet that has the names of about 20 different sales people, and a new row is created, with the salesmen name in column A, whenever they make a sale. But, I now want this data to be available to the salesmen, but I want only them to only be able to view their info, not everyones. So, I am going to create 20 different individual files, one for each salesman.

Is there a formula that I can use for these 20 different spreadsheets to update for that specific salesmen every time I update the master sheet?

  • Of course with a vlookup you can return the values of each salesman like in this link: https://www.extendoffice.com/documents/excel/2699-excel-vlookup-find-first-2nd-match.html – Pierre44 Oct 26 '18 at 13:45
  • 1
    Create a master sheet – Imran Malek Oct 26 '18 at 13:48
  • 1
    Rather than creating 20 different workbooks, you could just create sheets in your `Main` workbook and hide the sheets. You can than display the sheet for logged in user. This way all your data stays in 1 workbook and your formulas become a lot easier – Zac Oct 26 '18 at 14:05

1 Answers1

0

You could create workbooks from a Column (Looping from row 1 to x) based on unique values.

So for each unique salesmen in Column A you create a new workbook. Then you only need to use your current Master file, and do whatever you want in that file. When you want to send a sheet to a sales person, you execute the code and Excel will copy all rows that belongs to the specific sales man and create 20 individual sheets for you which you can send.

Process:

I have a file in a folder, which I have all my main data.

enter image description here

The main data looks like this, and the new workbooks will be named after Column A. It will only create workbook for unique names.

enter image description here

After running the macro it has create the following 5 new workbooks.

enter image description here

This is how Workbook "Anne - 10-27-18,14.24.47.xlsx" looks like:

enter image description here

This is how Workbook "Belle- 10-27-18,14.24.47.xlsx" looks like:

enter image description here

I used the following code and only modified to make it dynamic of the unique list column. All credit to J. Fox at SO

VBA Code:

Option Explicit

Sub ExportByName()
'Source and Credit: https://stackoverflow.com/questions/46368771/how-to-create-a-new-workbook-for-each-unique-value-in-a-column

Dim unique(1000) As String 'How many unique values we can store
Dim wb(1000) As Workbook
Dim ws As Worksheet
Dim x As Long, y As Long, ct As Long, uCol As Long, ColName As Long
Dim StaticDate As Date

On Error GoTo ErrHandler

Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual

'Your main worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")

'Column Where Unique Names are
ColName = 1

uCol = 12 'End column of data in MainFile


ct = 0

'get a unique list of users
For x = 2 To ws.Cells(ws.Rows.Count, ColName).End(xlUp).Row
    If CountIfArray(ActiveSheet.Cells(x, ColName), unique()) = 0 Then
        unique(ct) = ActiveSheet.Cells(x, ColName).Text
        ct = ct + 1
    End If
Next x

StaticDate = Now() 'This create the same timestamp for all the new workbooks

'loop through the unique list
For x = 0 To ws.Cells(ws.Rows.Count, ColName).End(xlUp).Row - 1

    If unique(x) <> "" Then
        'add workbook
        Set wb(x) = Workbooks.Add

        'copy header row
        ws.Range(ws.Cells(1, 1), ws.Cells(1, uCol)).Copy wb(x).Sheets(1).Cells(1, 1)

        'loop to find matching items in ws and copy over
        For y = 2 To ws.Cells(ws.Rows.Count, ColName).End(xlUp).Row
            If ws.Cells(y, ColName) = unique(x) Then

                'copy full formula over
                'ws.Range(ws.Cells(y, 1), ws.Cells(y, uCol)).Copy wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)) + 1, 1)

                'to copy and paste values
                ws.Range(ws.Cells(y, 1), ws.Cells(y, uCol)).Copy
                wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)) + 1, 1).PasteSpecial (xlPasteValues)

            End If
        Next y

        'autofit
        wb(x).Sheets(1).Columns.AutoFit

        'save when done
        wb(x).SaveAs ThisWorkbook.Path & "\" & unique(x) & " - " & Format(StaticDate, "mm-dd-yy, hh.mm.ss") & ".xlsx"
        wb(x).Close SaveChanges:=True

    Else
        'once reaching blank parts of the array, quit loop
        Exit For
    End If

Next x

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

ErrHandler:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Public Function CountIfArray(lookup_value As String, lookup_array As Variant)
CountIfArray = Application.Count(Application.Match(lookup_value, lookup_array, 0))
End Function
Wizhi
  • 6,424
  • 4
  • 25
  • 47