Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 528
  • Last Modified:

Create a macro to convert multiple .txt file to .xls file and place all data in .xls file

I would like the macro to do the following :

convert multiple .txt files in a folder
should delimit the .txt files so that there are headers in each column
format for date (1st column) should be in DDMMYY format
place all data from .txt files into 1 .xls file
scan through the data in .xls file
ensure all data are unique (ie. no repeated data in each row)

Is the above feasible ?

0
ceneiqe
Asked:
ceneiqe
  • 12
  • 7
  • 2
  • +2
1 Solution
 
Robert SchuttSoftware EngineerCommented:
could you provide some example contents?
are the headers the same in each txt file?
0
 
ceneiqeAuthor Commented:
yes. headers the same as the txt  file.
0
 
SiddharthRoutCommented:
Could you please provide 2 sample text files so that I can test it before uploading a sample

Sid
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
Robert SchuttSoftware EngineerCommented:
here's a first stab at it; will probably need some work as your information is a bit sparse.

 txtimp.zip
0
 
ceneiqeAuthor Commented:
0
 
SiddharthRoutCommented:
Can you please upload a complete text file as it contains just 4 lines

That way I can give you a macro will will work perfectly. If you want to do it on your own, then see this link :)

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_26981715.html

Sid
0
 
ceneiqeAuthor Commented:
the data are all numbers. numerical values under the headers.
for date is in YY-MM-DD format.
and i would like toconvert them to DD-MM-YY format.

0
 
SiddharthRoutCommented:
I repeat :)

Could you please upload a sample?

Sid
0
 
ceneiqeAuthor Commented:
0
 
SiddharthRoutCommented:
Thank you. One last question. Are all the files in the exact same format?

Sid
0
 
ceneiqeAuthor Commented:
Are all the files in the exact same format?

>> yes
0
 
SiddharthRoutCommented:
Thank you. Please give me a short while.

Sid
0
 
SiddharthRoutCommented:
ceneiqe:The code is ready. Just want to confirm. When you say duplicates, do you mean same KG-GROSS value or do you want to compare all the columns except the date?

Sid
0
 
ceneiqeAuthor Commented:
compare all the columns except the date. Thanks.
0
 
SiddharthRoutCommented:
Ok. Here is a sample. Please unzip the folder and open the Excel file. Click on the "Generate Button to process the files. The output will be generated in a new sheet called "Output".

Also In the folder you will find few txt files that I used for testing purpose.

And also please change the path in the code below

Fldr = "C:\txt"

HTH

Sid

Code Used

Dim wb As Workbook, wb1 As Workbook
Dim ws As Worksheet, ws1 As Worksheet
Dim wsLRw As Long, ws1LRw As Long
Dim Fldr As String
Dim MYFileArray() As String
Dim j As Long


Sub Generate()
    Dim rng As Range
    Application.ScreenUpdating = False
    
    Fldr = "C:\txt"
    j = 0
    
    Set wb = ActiveWorkbook
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Output").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set ws = wb.Sheets.Add
    ws.Name = "Output"
    wsLRw = 1
    ListFiles Fldr, "*.txt"
    
    For i = 1 To UBound(MYFileArray)
        '~~> The below code till "ActiveWorkbook.Close" has not been tested
        Set wb1 = Workbooks.Open(Filename:=MYFileArray(i))
        Set ws1 = wb1.Sheets(1)
        ws1LRw = ws1.Range("A" & Rows.Count).End(xlUp).Row
        ws1.Rows("1:" & ws1LRw).Copy ws.Range("A" & wsLRw)
        ws.Activate
        wsLRw = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
       
        wb1.Close savechanges:=False
    Next
    
    With ws
        .Range("1:2,4:4").Delete Shift:=xlUp
        
        '~~> CleanUpdata
        wsLRw = .Range("A" & Rows.Count).End(xlUp).Row
        
        For i = wsLRw To 2 Step -1
            Select Case Left(.Range("A" & i).Value, 4)
            Case "====", "Day:", "----", "DATE"
                If rng Is Nothing Then
                    Set rng = .Rows(i)
                Else
                    Set rng = Union(rng, .Rows(i))
                End If
            End Select
        Next i
        rng.Delete Shift:=xlUp
        .Columns("A:A").TextToColumns Destination:=.Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(8, 1), Array(28, 1), Array(32, 1), Array(44, 1), _
        Array(50, 1), Array(59, 1), Array(65, 1)), TrailingMinusNumbers:=True
        
        .Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
        
        Columns("A:A").NumberFormat = "dd-mm-yy"
        
        '~~> Delete Duplicate Data
        .Columns("A:I").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
        wsLRw = .Range("A" & Rows.Count).End(xlUp).Row
        
        '~~> Delete Duplicate Data
        wsLRw = .Range("A" & Rows.Count).End(xlUp).Row
        For k = wsLRw To 2 Step -1
            If .Range("B" & k).Value = .Range("B" & k - 1).Value And _
            .Range("C" & k).Value = .Range("C" & k - 1).Value And _
            .Range("D" & k).Value = .Range("D" & k - 1).Value And _
            .Range("E" & k).Value = .Range("E" & k - 1).Value And _
            .Range("F" & k).Value = .Range("F" & k - 1).Value And _
            .Range("G" & k).Value = .Range("G" & k - 1).Value And _
            .Range("H" & k).Value = .Range("H" & k - 1).Value And _
            .Range("I" & k).Value = .Range("I" & k - 1).Value Then
                .Rows(k).Delete
            End If
        Next k
        
        .Cells.EntireColumn.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

Public Function ListFiles(FolderPath As String, Extension As String)
    Dim i As Long
    Dim FolderName As String
    Dim DirNames() As String
    Dim SubDirectories As Long
    
    '~~> List files in the main/first folder
    On Error Resume Next
    FolderName = Dir(FolderPath & "\" & Extension, vbDirectory)
    On Error GoTo 0
    
    
    Do While FolderName <> vbNullString
        j = j + 1
        ReDim Preserve MYFileArray(j)
        MYFileArray(j) = FolderPath & "\" & FolderName
        FolderName = Dir()
    Loop
    
    '~~> Get the sub directories
    On Error Resume Next
    FolderName = Dir(FolderPath & "\*.*", vbDirectory)
    On Error GoTo 0

    Do While FolderName <> vbNullString
        If FolderName <> "." And FolderName <> ".." Then
            SubDirectories = SubDirectories + 1
            ReDim Preserve DirNames(1 To SubDirectories)
            DirNames(SubDirectories) = FolderName
        End If
        FolderName = Dir()
    Loop

    For i = 1 To SubDirectories
        ListFiles FolderPath & "\" & DirNames(i), Extension
    Next i
End Function

Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

Open in new window

txt.zip
0
 
ceneiqeAuthor Commented:
ok, let me try first , thks
0
 
ceneiqeAuthor Commented:
the dates are in wrong format.

it should change from yy-mm-dd to dd-mm-yy format

02-11-13  which should be 13-02-11 (in dd-mm-yy format)
03-11-13
02-11-06
01-11-16
01-11-22
01-11-30
02-11-03
02-11-12
12-10-27
03-11-20
03-11-12
04-11-10
04-11-10
04-11-10
04-11-10
02-11-20
02-11-04
03-11-06
01-11-23
01-11-15
01-11-01
05-11-02
04-11-16
04-11-16
04-11-16
04-11-16
04-11-23
04-11-23
04-11-23
04-11-23
02-11-02
12-10-26
01-11-09
02-11-26
04-11-09
04-11-09
04-11-09
04-11-09
01-11-03
02-11-27
04-11-17
04-11-17
04-11-17
04-11-17
03-11-05
04-11-02
04-11-02
04-11-02
01-11-29
02-11-05
03-11-27
03-11-27
01-11-17
04-11-24
04-11-24
04-11-24
04-11-24
02-11-01
03-11-26
01-11-24
04-11-03
04-11-03
04-11-03
04-11-30
05-11-01
01-11-08
03-11-19
04-11-25
04-11-25
04-11-25
04-11-25
03-11-28
03-11-28
03-11-28
01-11-02
12-10-28
02-11-19
01-11-21
02-11-07
04-11-22
04-11-22
04-11-22
04-11-22
12-10-29
01-11-31
02-11-09
01-11-10
01-11-04
12-10-31
02-11-08
02-11-14
04-11-11
04-11-11
04-11-11
04-11-11
05-11-03
03-11-14
02-11-15
04-11-18
04-11-18
04-11-18
04-11-18
02-11-16
03-11-07
02-11-10
01-11-19
01-11-25
04-11-26
04-11-26
04-11-26
04-11-19
04-11-19
04-11-19
04-11-19
01-11-28
03-11-21
04-11-05
04-11-05
04-11-05
04-11-05
02-11-28
01-11-18
03-11-15
04-11-21
04-11-21
04-11-21
04-11-21
02-11-18
12-10-30
03-11-09
02-11-11
04-11-14
04-11-14
04-11-14
04-11-14
04-11-13
04-11-13
04-11-13
04-11-13
01-11-05
04-11-08
04-11-08
04-11-08
04-11-08
01-11-27
01-11-07
04-11-12
04-11-12
04-11-12
04-11-12
01-11-26
04-11-07
04-11-07
04-11-07
04-11-07
03-11-16
03-11-22
03-11-18
04-11-06
04-11-06
04-11-06
04-11-06
01-11-12
03-11-02
03-11-23
02-11-21
01-11-20
03-11-03
03-11-08
01-11-13
04-11-15
04-11-15
04-11-15
04-11-15
03-11-10
04-11-27
04-11-27
04-11-29
03-11-17
03-11-24
01-11-11
02-11-25
02-11-25
03-11-04
03-11-11
02-11-22
01-11-14
04-11-04
04-11-04
04-11-04
04-11-04
03-11-30
03-11-30
03-11-30
02-11-23
04-11-01
04-11-01
04-11-01
03-11-31
03-11-31
03-11-31
03-11-01
03-11-29
03-11-29
03-11-29
01-11-06
02-11-24
02-11-17
04-11-28
04-11-20
04-11-20
04-11-20
04-11-20
0
 
ceneiqeAuthor Commented:
the macro is ok except the date format has gone weird.
anyone knows how to convert the text to date format (dd/mm/yy) ?
0
 
Saqib Husain, SyedEngineerCommented:
Insert this code at line 67.

Remember this is only to assist Sid who appears to be away. NOT FOR POINTS

Saqib
For Each cel In Range("A:A")
if cel<>"" then
sl2 = InStr(InStr(cel.Text, "/") + 1, cel.Text, "/")
cel.Offset(0, 1).Value = CVDate(Format(Right(cel.Text, Len(cel.Text) - sl2), "00") & "/" & Left(cel, sl2 - 1))
endif
Next cel

Open in new window

0
 
ceneiqeAuthor Commented:
Ok, let me try and get back.
Thanks !
0
 
bromy2004Commented:
I've requested that this question be closed as follows:

Accepted answer: 200 points for SiddharthRout's comment http:/Q_26980319.html#35489706

for the following reason:

This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
 
ceneiqeAuthor Commented:
I will review the codes by 10 June.
0
 
ceneiqeAuthor Commented:
hi ssaqibh, is it possible to copy the Full code for me ?

i think i got errors by inserting your new code. thks.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 12
  • 7
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now