Thread: array formulas
View Single Post
  #13   Report Post  
Harlan Grove
 
Posts: n/a
Default

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.Co unt))
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