ASHIS
12/24/2014 - 9:43 AM

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

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

v1_DpSegModCOUNTRY.vbs
content_copyfile_download
Option Explicit

Sub DPSegModCOUNTRY()
Dim ArrV() As Variant, ScrDIC As Object, I As Variant, 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
If Application.WorksheetFunction.CountA(Range("A:A")) = 1 Then Range("A1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove    'Insert a cell above cell A1 if only value is provided in the column A:A.
ArrV = Application.Transpose(Range([A1], Cells(Rows.count, "A").End(xlUp))) 'Stores all the value in the column 'A' 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.

'ActiveWorkbook.Sheets("DpDUMP").Select
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)

'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
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Offset(1, 0).Copy

'Open the 'SEGMOD TEMPLATE' & paste the value copied form 'DP' Sheet!
    Set SegModTEMP = Excel.Application.Workbooks.Open(ActiveWorkbook.Path & "\SEGMOD TEMPLATE.xlsm")
    With ActiveWorkbook
        .Sheets("DP").Activate
        .Sheets("DP").Range("A2").Select
    End With
    ActiveSheet.Paste
    'Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, 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
    With ActiveWorkbook
        .Sheets("SITE").Activate
        .Sheets("SITE").Range("A2").Select
    End With
    ActiveSheet.Paste
    'Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Save the file on the User's Desktop in todays date & CSV format!
    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & ArrV(I) & " " & Format(Date, "YYYYMMDD") & ".xlsm", FileFormat:=52, CreateBackup:=False
    Workbooks(ArrV(I) & " " & Format(Date, "YYYYMMDD") & ".xlsm").Close
SkipSITE:
Next
    'Removes filter before concluding the procedure run!
    Application.Run "AutoFILTER"    'Calls the procedure that Auto Filters the spreadsheet!
    ActiveWorkbook.Sheets("COUNTRY").Select
End Sub
DpSegModCOUNTRY.vbs
content_copyfile_download
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
LastROW = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row  'Count the No. of rows in the Used Range of the Sheet:SgDUMP!
ArrV = Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp))) 'Stores all the value in the column 'A' 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.

ActiveWorkbook.Sheets("DpDUMP").Select
LastROW = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row  'Count the No. of rows in the Used Range of the Sheet:SgDUMP!
For I = LBound(ArrV) To UBound(ArrV)
    Application.Run "AutoFILTER"    'Calls the procedure that Auto Filters the spreadsheet!
    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 Skip

'Copy the filtered content from 'SgDUMP' Sheet!
    ActiveWorkbook.Sheets("DpDUMP").Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Offset(1, 0).Copy

'Open the SegMod templet & paste the value copied form SgDUMP Sheet!
    Set SegModTEMP = Excel.Application.Workbooks.Open(ActiveWorkbook.Path & "\SEGMOD TEMPLATE.xlsm")
    With ActiveWorkbook
        .Sheets("DP").Activate
        .Sheets("DP").Range("A2").Select
    End With
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Save the file on the User's Desktop in todays date & CSV format!
    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & "DP" & " " & ArrV(I) & " " & Format(Date, "YYYYMMDD") & ".xlsm", FileFormat:=52, CreateBackup:=False
    Workbooks("DP" & " " & ArrV(I) & " " & Format(Date, "YYYYMMDD") & ".xlsm").Close
Skip:
Next
    'Removes filter before concluding the procedure run!
    Application.Run "AutoFILTER"    'Calls the procedure that Auto Filters the spreadsheet!
    ActiveWorkbook.Sheets("COUNTRY").Select
End Sub

Sub SiteSegModCOUNTRY()
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
LastROW = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row  'Count the No. of rows in the Used Range of the Sheet:SgDUMP!
ArrV = Application.Transpose(Range([a1], Cells(Rows.Count, "A").End(xlUp))) 'Stores all the value in the column 'A' 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.

ActiveWorkbook.Sheets("SiteDUMP").Select
LastROW = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row  'Count the No. of rows in the Used Range of the Sheet:SgDUMP!
For I = LBound(ArrV) To UBound(ArrV)
    Application.Run "AutoFILTER"    'Calls the procedure that Auto Filters the spreadsheet!
    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 Skip

'Copy the filtered content from 'SgDUMP' Sheet!
    ActiveWorkbook.Sheets("SiteDUMP").Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Offset(1, 0).Copy

'Open the SegMod templet & paste the value copied form SgDUMP Sheet!
    Set SegModTEMP = Excel.Application.Workbooks.Open(ActiveWorkbook.Path & "\SEGMOD TEMPLATE.xlsm")
    With ActiveWorkbook
        .Sheets("SITE").Activate
        .Sheets("SITE").Range("A2").Select
    End With
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  
'Save the file on the User's Desktop in todays date & CSV format!
    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & "SITE" & " " & ArrV(I) & " " & Format(Date, "YYYYMMDD") & ".xlsm", FileFormat:=52, CreateBackup:=False
    Workbooks("SITE" & " " & ArrV(I) & " " & Format(Date, "YYYYMMDD") & ".xlsm").Close
Skip:
Next
    'Removes filter before concluding the procedure run!
    Application.Run "AutoFILTER"    'Calls the procedure that Auto Filters the spreadsheet!
    ActiveWorkbook.Sheets("COUNTRY").Select
End Sub
AutoFILTER.vbs
content_copyfile_download
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