SEGMENTATION MODELER [Diff. File for DP & SITE]: 24th Dec, 2014! Splits & Creates DP & Site file from SegMod Data Dump File for each Country!
Option Explicit
Sub DPSegModCOUNTRY()
Dim ArrV As Variant, ScrDIC As Object, I As Long, LastROW As Long, FltrCOUNT As Long, SegModTEMP As Workbook
Set ScrDIC = CreateObject("Scripting.Dictionary") 'Create a 'Scripting Dictionary' object to store only unique value!
ActiveWorkbook.Sheets("COUNTRY").Select
ArrV = Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp))) 'Stores all the value in the column 'A' of Sheet 'COUNTRY' to the Array 'ArrV'!
For I = LBound(ArrV) To UBound(ArrV) 'Uses 'Scripting Dictionary' object to store only unique value!
ScrDIC(ArrV(I)) = 1
Next
ArrV = ScrDIC.Keys 'Dumps the Unique values from 'Scripting Dictionary' object into the Array.
'----------------------------------------------------------------------------------------------------
For I = LBound(ArrV) To UBound(ArrV)
ActiveWorkbook.Sheets("DpDUMP").Select
Application.Run "AutoFILTER" 'Calls the procedure that Auto Filters the spreadsheet!
LastROW = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row 'Count the No. of rows in the Used Range of the Sheet:SgDUMP!
ActiveSheet.Range("A1:AX" & LastROW).AutoFILTER Field:=3, Criteria1:=ArrV(I) 'Filters out the respective country in the range (range till the last row of the respective sheet)
'Count the number of filtered Rows & skip to next filter if the count is zero!
If (ActiveSheet.AutoFILTER.Range.SpecialCells(xlCellTypeVisible).Count / ActiveSheet.AutoFILTER.Range.Columns.Count) - 1 < 1 Then GoTo SkipDP
'Copy the filtered content from 'SgDUMP' Sheet!
ActiveWorkbook.Sheets("DpDUMP").Range("A1").Select 'Select Cell A1 of the DpDUMP Sheet!
Range(Selection, Selection.End(xlToRight)).Select 'Select all the Cell of Row 1 as long as it contains value!
Range(Selection, Selection.End(xlDown)).Offset(1, 0).Copy 'Select all the Cell of the Range (all rows & column) that contains value excluding Row 1 & Copies it!
'Open the 'SEGMOD TEMPLATE' & paste the value copied form 'DP' Sheet!
Set SegModTEMP = Excel.Application.Workbooks.Open(ActiveWorkbook.Path & "\SEGMOD TEMPLATE.xlsm")
ActiveWorkbook.Sheets("DP").Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
SkipDP:
'Filter the 'SegMod DATA DUMP' file 'SITE' sheet for country data!
Windows("SegMod DATA DUMP.xlsm").Activate
ActiveWorkbook.Sheets("SiteDUMP").Select
Application.Run "AutoFILTER" 'Calls the procedure that Auto Filters the spreadsheet!
LastROW = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row 'Count the No. of rows in the Used Range of the Sheet:SgDUMP!
ActiveSheet.Range("A1:AX" & LastROW).AutoFILTER Field:=3, Criteria1:=ArrV(I)
'Count the number of filtered Rows & skip to next filter if the count is zero!
If (ActiveSheet.AutoFILTER.Range.SpecialCells(xlCellTypeVisible).Count / ActiveSheet.AutoFILTER.Range.Columns.Count) - 1 < 1 Then GoTo SkipSITE
'Copy the filtered content from 'SiteDUMP' Sheet!
ActiveWorkbook.Sheets("SiteDUMP").Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Offset(1, 0).Copy
'Activate the 'SEGMOD TEMPLATE' & paste the value copied form 'SITE' Sheet!
Windows("SEGMOD TEMPLATE.xlsm").Activate
ActiveWorkbook.Sheets("SITE").Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Save the file on the User's Desktop in todays date & xlsm format!
On Error Resume Next
'MkDir "\" & ArrV(I) & " " & Format(Date, "YYYYMMDD") & ""
ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & ArrV(I) & " " & Format(Date, "YYYYMMDD") & ".xlsm", FileFormat:=52, CreateBackup:=False
Workbooks(ArrV(I) & " " & Format(Date, "YYYYMMDD") & ".xlsm").Close
On Error GoTo 0
SkipSITE:
Next
'----------------------------------------------------------------------------------------------------
'Removes filter before concluding the procedure run!
Erase ArrV 'Erasing the value in the array: 'ArrV'!
Application.Run "AutoFILTER" 'Calls the procedure that Auto Filters the spreadsheet!
ActiveWorkbook.Sheets("COUNTRY").Select 'Select the worksheet COUNTRY in the 'SegMod DATA DUMP' worksheet!
End Sub
Private Sub AutoFILTER()
ActiveSheet.AutoFilterMode = False 'Removes AutoFilter!
If Not ActiveSheet.AutoFilterMode Then ActiveSheet.Cells(1, 1).AutoFILTER 'Autofilter if not filtered already!
End Sub