johnT wrote...
I have a rather large spreadsheet listing salesmen,
customers, locations etc. I would like to create separate
worksheets for each salesman listing only data related to
that salesman...on each worksheet i want to referance the
master worksheet, how can i do this without having a large
group of blank rows??? I think this may be an application
for array formulas but i need some help.
Many responses with formulas, but if you want to use the single master
worksheet for data entry, so each salesperson's data in their own
worksheet would effectively be static data, you'd be better off using a
macro to to copy records to each individual's worksheet. This could
also provide the useful additional functionality of adding new
worksheets for new salespersons appearing in the list and deleting
worksheets for salespersons no longer appearing in the list (possibly
prompting you to confirm deletion).
If the sales data table were named SalesTable with salesperson ID in
the first/leftmost column, then something like
Sub foo()
Dim i As Long, j As Long, k As Long, n As Long
Dim id As String, ta As String
Dim dr As Range, nr As Range, tr As Range
Dim xr As Object, ws As Worksheet
Set xr = CreateObject("Scripting.Dictionary")
Set dr = ThisWorkbook.Names("SalesTable").RefersToRange
k = dr.Columns.Count - 1
n = dr.Rows.Count - 1
ta = ActiveSheet.Range("A3", Cells(3, k)).Address(0, 0) 'H/C
Set nr = dr.Offset(1, 0).Resize(n, 1)
Set tr = dr.Offset(0, 1).Resize(1, k)
Set dr = dr.Offset(1, 1).Resize(n, k)
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> dr.Worksheet.Name Then
id = ws.Range("B1").Value 'H/C
xr.Add id, ws.Name
ws.Range("A4:IV65536").ClearContents 'H/C
If Application.WorksheetFunction.CountIf(nr, id) = 0 Then
If MsgBox( _
Prompt:="Salesperson '" & id & "' has a " & _
"worksheet but no entries in SalesTable." & _
Chr(13) & Chr(13) & "Delete the worksheet?", _
Buttons:=vbYesNo, _
Title:="No Data" _
) = vbYes Then
ws.Delete
End If
End If
End If
Next ws
For i = 1 To n
id = nr.Cells(i, 1).Value
If xr.Exists(id) Then
j = .Worksheets(xr.Item(id)).Range(ta).End(xlDown).Row
If j = Rows.Count Then j = 1 Else j = j - 2
ThisWorkbook.Worksheets( _
xr.Item(id)).Range(ta).Offset(j, 0).Value = _
dr.Rows(i).Value
Else
Set ws = ThisWorkbook.Worksheets.Add(After:= _
ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
xr.Add id, ws.Name
ws.Range("A1").Value = _
dr.Offset(-1, -1).Resize(1, 1).Value 'H/C
ws.Range("B1").Value = id 'H/C
ws.Range(ta).Value = tr.Value
ThisWorkbook.Worksheets( _
xr.Item(id)).Range(ta).Offset(1, 0).Value = _
dr.Rows(i).Value
End If
Next i
Set xr = Nothing
End Sub
