ASHIS
12/24/2014 - 9:41 AM

SEGMENTATION MODELER [Diff. File for DP & SITE]: 24th Dec, 2014! Splits & Creates DP & Site file from SegMod Data Dump File for each Country

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