Hello prkhan56,
This VBA macro will create one sheet for each location using the "Master" as a template. The attached workbook has the macro added and a button on the "Master" to run it.
' Thread: http://www.excelforum.com/excel-programming-vba-macros/1145602-macro-to-create-separate-sheet-for-each-unique-value-in-col-g-and-put-sumifs-formula.html
' Poster: prkhan56
' Author: Leith Ross
Sub Run()
Dim Cell As Range
Dim j As Long
Dim LocalId As Variant
Dim LocalIds As Variant
Dim Master As Worksheet
Dim n As Long
Dim res As Variant
Dim Sorted As Boolean
Dim Wks As Worksheet
Dim ZtoA As Boolean ' Set this true if you want the sort order to be descending (z to a).
ReDim LocalIds(0)
Set Master = ThisWorkbook.Worksheets("Master")
With ThisWorkbook.Worksheets("Data")
Set RngBeg = .Range("G5")
Set RngEnd = .Cells(Rows.Count, RngBeg.Column).End(xlUp)
For Each Cell In .Range(RngBeg, RngEnd)
res = Application.Match(Cell.Value, LocalIds, 0)
If IsError(res) Then
n = UBound(LocalIds)
LocalIds(n) = Cell.Value
ReDim Preserve LocalIds(n + 1)
End If
Next Cell
End With
Do
Sorted = True
For j = 0 To n - 1
If ZtoA Xor StrComp(LocalIds(j), LocalIds(j + 1), vbTextCompare) = 1 Then
res = LocalIds(j + 1)
LocalIds(j + 1) = LocalIds(j)
LocalIds(j) = res
Sorted = False
End If
Next j
n = n - 1
Loop Until Sorted Or n < 1
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
For n = 0 To UBound(LocalIds) - 1
LocalId = LocalIds(n)
On Error Resume Next
Set Wks = ThisWorkbook.Worksheets(LocalId)
If Err <> 0 Then
Master.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Set Wks = ActiveSheet
Wks.Name = LocalId
Wks.Range("L2") = LocalId
End If
On Error GoTo 0
Next n
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Bookmarks