Link to home
Start Free TrialLog in
Avatar of Naresh Patel
Naresh PatelFlag for India

asked on

TT Add Columns

I had this question after viewing TT Text To Column Based On Criteria.

Hi Experts,

This FollowUp of my previous Question ...need to add further step in existing Module M2_SplitImportData.....need to save import sheet in new work book with sheet name as todays date i.e. =TODAY() (DD-MMM-YYYY) Format and  same name as DD-MMM-YYYY in directory D:\WIP Historicals..

See Attached

Thanks
-TT-WIP.xlsm
Avatar of Rgonzo1971
Rgonzo1971

Hi,

pls try
Sub SplitImportData()
    Dim strPath As String, strNewPath As String
    Dim wsImport As Worksheet
    strPath = "D:\WIP Historicals"

    Set wsImport = ThisWorkbook.Worksheets("Import")
    
    wsImport.Select
    If wsImport.Range("A1") = "" Then
        wsImport.Rows("1:2").Delete
        wsImport.Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 4), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 4), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 4), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 4), Array( _
        33, 4), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 4), Array(38, 1), Array(39, 1), _
        Array(40, 4), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 4), Array(45, 1), Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
        Array(53, 1), Array(54, 1), Array(55, 1)), DecimalSeparator:=".", _
        ThousandsSeparator:=",", TrailingMinusNumbers:=True
    End If
    wsImport.Columns.AutoFit
    wsImport.Copy
    strNewPath = strPath & "\" & Format(Date, "DD-MMM-YYYY")
    If Dir(strNewPath, vbDirectory) = "" Then MkDir (strNewPath)
    ActiveWorkbook.SaveAs strNewPath & "\" & Format(Date, "DD-MMM-YYYY") & ".xlsx"
End Sub

Open in new window

Regards
Avatar of Naresh Patel

ASKER

1) what if we need to remain close new work book which being created i.e. new workbook which being created need to be closed ..
2) not required to create new folder just workbook only.
3) if same file already exist ....over past .

Thanks
then try
Sub SplitImportData()
    Dim strPath As String
    Dim wsImport As Worksheet
    strPath = "D:\WIP Historicals"

    Set wsImport = ThisWorkbook.Worksheets("Import")
    
    wsImport.Select
    If wsImport.Range("A1") = "" Then
        wsImport.Rows("1:2").Delete
        wsImport.Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 4), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 4), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 4), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 4), Array( _
        33, 4), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 4), Array(38, 1), Array(39, 1), _
        Array(40, 4), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 4), Array(45, 1), Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
        Array(53, 1), Array(54, 1), Array(55, 1)), DecimalSeparator:=".", _
        ThousandsSeparator:=",", TrailingMinusNumbers:=True
    End If
    wsImport.Columns.AutoFit
    wsImport.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs strPath & "\" & Format(Date, "DD-MMM-YYYY") & ".xlsx"
    Application.DisplayAlerts = True
    ActiveWorkbook.Close False
End Sub

Open in new window

Working perfect but need to stop all process if cell A1<>"" as in current scenario if cell A1<>"" still macro create new file and over past it...

Please see

thanks
Hi Experts,

This FollowUp of my previous Question ...need to add further step in existing Module M2_SplitImportData.....need to save import sheet in new work book with sheet name as todays date i.e. =TODAY() (DD-MMM-YYYY) Format and  same name as DD-MMM-YYYY in directory D:\WIP Historicals..

See Attached

For this question ----only requirement in your posted macro ....nothing happen if Cell A2<>"" And A2="" then macro do its job.

Thanks
ASKER CERTIFIED SOLUTION
Avatar of Rgonzo1971
Rgonzo1971

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Perfect