CONSOLIDATION OF TEXT FILES. DATA FROM VARIOUS COLUMNS.

[Sinner]

Hi,

I have around 25 text files with pipe sign delimited data.
Header lines start at row 9.

I want to consolidate all the data in one worksheet named DATA.

Requirement is as follows:

- Worksheet data is of three columns.
..columnA header is Category
..columnB header is Number
..columnC header is LOCATION

- A group of text files have required data in columnB & another in
columnC. So these group of files need to be defined in import
sequence.

- Import values from all text files as text.

- Text file name are 1,2,3,4,5......25. The Category name should be a
list of names like for 1 its 'K', for 2 its, 'P' an so on making it
possible to modify later on as well.
Once the data is imported from file 1 text file, the data should goto
columnB & category should be 'K' for all data & so on for rest of the
files accordingly.

A 'TEMP' sheet will help to make sure we can modify import
requirements from there instead the main code.

Sample file is at
http://www.savefile.com/files/1786679

Any help is appreciated.

Thx.

 

[Joel]

You need to create a new sheet TEMP1 to use as a temporary sheet to read the
data. I then copy the corrct column to the DATA sheet. You also need to
change the Folder Location as required. I didn't know if the file names
contained an extension or not. The line below may need to change. Also you
sheet TEMP was't completely filled in. What will happen if there is not
column number? The code will have an error when you run it.

Modify if necessary below
from
Connection:="TEXT;" & Folder & FName, _
to
Connection:="TEXT;" & Folder & FName & ".txt", _


Sub GetData()
'
'
Folder = "C:\temp\"

With Sheets("Data")
.Cells.ClearContents
.Range("A1") = "Category"
.Range("B1") = "Number"
.Range("C1") = "Location"
End With

With Sheets("Temp")
RowCount = 2
Do While .Range("A" & RowCount) <> ""
FName = .Range("A" & RowCount)
Category = .Range("B" & RowCount)
Col = .Range("C" & RowCount)
Location = .Range("D" & RowCount)

With Sheets("Temp1")
.Cells.ClearContents
With .QueryTables.Add( _
Connection:="TEXT;" & Folder & FName, _
Destination:=Range("A1"))

.Name = "Test"
.FieldNames = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFileStartRow = 10
.TextFileParseType = xlDelimited
.TextFileOtherDelimiter = "|"
.Refresh BackgroundQuery:=False
End With

Set LastCell = .Cells(Rows.Count, Col).End(xlUp)
Set CopyRange = .Range(Cells(1, Col), LastCell)
End With

With Sheets("Data")
LastRow = .Range("B" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
CopyRange.Copy Destination:=.Range("B" & NewRow)
LastRow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A" & NewRow & ":A" & LastRow) = Category
.Range("C" & NewRow & ":C" & LastRow) = Location
End With
RowCount = RowCount + 1
Loop
End With

End Sub

 

[Sinner]

You need to create a new sheet TEMP1 to use as a temporary sheet to read the
data.  I then copy the corrct column to the DATA sheet.  You also need to
change the Folder Location as required.  I didn't know if the file names
contained an extension or not.  The line below may need to change.  Also you
sheet TEMP was't completely filled in.  What will happen if there is not
column number?  The code will have an error when you run it.

Modify if necessary below
from
           Connection:="TEXT;" & Folder & FName, _
to
           Connection:="TEXT;" & Folder & FName & ".txt", _

Sub GetData()
'
'
Folder = "C:\temp\"

With Sheets("Data")
   .Cells.ClearContents
   .Range("A1") = "Category"
   .Range("B1") = "Number"
   .Range("C1") = "Location"
End With

With Sheets("Temp")
   RowCount = 2
   Do While .Range("A" & RowCount) <> ""
      FName = .Range("A" & RowCount)
      Category = .Range("B" & RowCount)
      Col = .Range("C" & RowCount)
      Location = .Range("D" & RowCount)

      With Sheets("Temp1")
         .Cells.ClearContents
         With .QueryTables.Add( _
           Connection:="TEXT;" & Folder & FName, _
              Destination:=Range("A1"))

            .Name = "Test"
            .FieldNames = True
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFileStartRow = 10
            .TextFileParseType = xlDelimited
            .TextFileOtherDelimiter = "|"
            .Refresh BackgroundQuery:=False
         End With

         Set LastCell = .Cells(Rows.Count, Col).End(xlUp)
         Set CopyRange = .Range(Cells(1, Col), LastCell)
      End With

      With Sheets("Data")
         LastRow = .Range("B" & Rows.Count).End(xlUp).Row
         NewRow = LastRow + 1
         CopyRange.Copy Destination:=.Range("B" & NewRow)
         LastRow = .Range("B" & Rows.Count).End(xlUp).Row
         .Range("A" & NewRow & ":A" & LastRow) = Category
         .Range("C" & NewRow & ":C" & LastRow) = Location
      End With
      RowCount = RowCount + 1
   Loop
End With

End Sub
















- Show quoted text -

Dear Joel,

As required, I have made a Temp1 sheet & there are no blank column
now.
I have put the file extension line also as was mentioned cauz files
are 1.txt, 2.txt and so on.
Still I'm getting an error i.e. System Error &H80070070057
(-2147024809)

Secondly I would like to have a get file dialog at start of macro so
that I can browse to the file folder & select the files rather than
setting it to a fix folder destination 'c:\temp'

Lastly I would like to know that if I have file 2,3,5,6 in which 1 & 4
is missing but listed in temp sheet. Would i get an error.
I had those in the temp sheet and there was no actual file but having
or not having in temp sheet didn't made any difference.. comment pls.
Thx.

 

[Joel]

It is possible that the error is being caused by the file not existing. I
put code it to test for file. If you continue getting an error let me know
which instruction is failing and if any of the files are being read into the
worksheet. The errorinstruction should be highlighted in color. If not you
probably need to change a setting in the VBA menu as follows

Tools - Option - General - Break on All Errors

I added a Folder Browser to the code.

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Function GetFolder(Optional ByVal Name As String = _
"Select a folder.") As String
'-------------------------------------------------------------
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long

bInfo.pidlRoot = 0& 'Root folder = Desktop

bInfo.lpszTitle = Name

bInfo.ulFlags = &H1 'Type of directory to Return
oDialog = SHBrowseForFolder(bInfo) 'display the dialog

'Parse the result
path = Space$(512)

GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If

End Function
'
'
Sub GetData()

Folder = GetFolder & "\"

With Sheets("Data")
.Cells.ClearContents
.Range("A1") = "Category"
.Range("B1") = "Number"
.Range("C1") = "Location"
End With

With Sheets("Temp")
RowCount = 2
Do While .Range("A" & RowCount) <> ""
FName = .Range("A" & RowCount)
Category = .Range("B" & RowCount)
Col = .Range("C" & RowCount)
Location = .Range("D" & RowCount)

If Dir(Folder & FName & ".txt") <> "" Then
With Sheets("Temp1")
.Cells.ClearContents
With .QueryTables.Add( _
Connection:="TEXT;" & Folder & FName & ".txt", _
Destination:=Range("A1"))

.Name = "Test"
.FieldNames = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFileStartRow = 10
.TextFileParseType = xlDelimited
.TextFileOtherDelimiter = "|"
.Refresh BackgroundQuery:=False
End With

Set LastCell = .Cells(Rows.Count, Col).End(xlUp)
Set CopyRange = .Range(Cells(1, Col), LastCell)
End With

With Sheets("Data")
LastRow = .Range("B" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
CopyRange.Copy Destination:=.Range("B" & NewRow)
LastRow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A" & NewRow & ":A" & LastRow) = Category
.Range("C" & NewRow & ":C" & LastRow) = Location
End With
End If
RowCount = RowCount + 1
Loop
End With

End Sub

 

[Sinner]

It is possible that the error is being caused by the file not existing.  I
put code it to test for file.  If you continue getting an error let me know
which instruction is failing and if any of the files are being read into the
worksheet.  The errorinstruction should be highlighted in color.  If not you
probably need to change a setting in the VBA menu as follows

Tools - Option - General - Break on All Errors

I added a Folder Browser to the code.

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" _
   (ByVal pidl As Long, _
    ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" _
   (lpBrowseInfo As BROWSEINFO) As Long

Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type
    Function GetFolder(Optional ByVal Name As String = _
                "Select a folder.") As String
    '-------------------------------------------------------------
    Dim bInfo As BROWSEINFO
    Dim path As String
    Dim oDialog As Long

        bInfo.pidlRoot = 0&                 'Root folder = Desktop

        bInfo.lpszTitle = Name

        bInfo.ulFlags = &H1                 'Type of directory to Return
        oDialog = SHBrowseForFolder(bInfo)  'display the dialog

        'Parse the result
        path = Space$(512)

        GetFolder = ""
        If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
            GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
        End If

    End Function
'
'
Sub GetData()

Folder = GetFolder & "\"

With Sheets("Data")
   .Cells.ClearContents
   .Range("A1") = "Category"
   .Range("B1") = "Number"
   .Range("C1") = "Location"
End With

With Sheets("Temp")
   RowCount = 2
   Do While .Range("A" & RowCount) <> ""
      FName = .Range("A" & RowCount)
      Category = .Range("B" & RowCount)
      Col = .Range("C" & RowCount)
      Location = .Range("D" & RowCount)

      If Dir(Folder & FName & ".txt") <> "" Then
         With Sheets("Temp1")
            .Cells.ClearContents
            With .QueryTables.Add( _
               Connection:="TEXT;" & Folder & FName & "..txt", _
                  Destination:=Range("A1"))

               .Name = "Test"
               .FieldNames = True
               .SaveData = True
               .AdjustColumnWidth = True
               .RefreshPeriod = 0
               .TextFileStartRow = 10
               .TextFileParseType = xlDelimited
               .TextFileOtherDelimiter = "|"
               .Refresh BackgroundQuery:=False
            End With

            Set LastCell = .Cells(Rows.Count, Col).End(xlUp)
            Set CopyRange = .Range(Cells(1, Col), LastCell)
         End With

         With Sheets("Data")
            LastRow = .Range("B" & Rows.Count).End(xlUp).Row
            NewRow = LastRow + 1
            CopyRange.Copy Destination:=.Range("B" & NewRow)
            LastRow = .Range("B" & Rows.Count).End(xlUp).Row
            .Range("A" & NewRow & ":A" & LastRow) = Category
            .Range("C" & NewRow & ":C" & LastRow) = Location
         End With
      End If
      RowCount = RowCount + 1
   Loop
End With

End Sub









- Show quoted text -

Dear Joel,

I put the code in Temp1 & it is working.
If I place it as a module, it worked but with this error
"The destination range is not on the same worksheet that the Query
table is being created on."
Where exactly should I place the code?

Some options that I would like to discuss:
- The browse to file dialog is there but I want the other one. The one
like we attach a file in yahoo mail and a window opens & we see the
files & there is this filename & extension dropdown to select
extension : ) Can that be done? I can live with this but that one will
enable me to see the files in folder.
- The Temp1 sheet remains filled with I guess data of last text file.
Is there a way to leave it blank?
- The 2nd & 3rd column values in text file need to be imported as text
cauz they start with 0. Also the numbers are 12 or more than 12 values
long like 111111112365172 etc.
- A clear button to clear Data & Temp1 sheet if same workbook is used
to load files again.

Will let u know if there is some other bug.

Thx for ur reply : )

 

[Joel]

1) I think you need to make a simple change and add the period in front of
Range. I usually put all my code in Modules except events which need to be
in sheets or thisworkbook.

from
Destination:=Range("A1"))

to
Destination:=.Range("A1"))


2) Add the following statment just before the END Sub statement to clear
TEMP1. The code presently lears the sheet before data is put on the worksheet

sheets("temp1").Cells.ClearContents
End sub 'don't put two end sub statments


3) Any columns you want set to text yuneed to format the column as text
before the files are read. Once will be enough.

..Columns("B:C").numberformat = "@"

or

Sheets("temp1").Columns("B:C").numberformat = "@"

4) Here is a clear macro. You can put it in a button Control. If you put
the button on a worksheet then the macro has to be on the sheet where the
button is located but can clear other worksheets. If you add the Button to a
ToolBar then it will go on ThisWorkbook.

sub Clear Data
Sheets("Temp1").cells.Clearcontents
Sheets("Data").cells.Clearcontents

end sub

5) I'll look into another Directory Browser. Sometime I use the
GetOPenFileName to select first file and then extract the pathname of the
first file to get the folder.

 

[Sinner]

1) I think you need to make a simple change and add the period in front of
Range.  I usually put all my code in Modules except events which need to be
in sheets or thisworkbook.

from
Destination:=Range("A1"))

to
Destination:=.Range("A1"))

2) Add the following statment just before the END Sub statement to clear
TEMP1.  The code presently lears the sheet before data is put on the worksheet

sheets("temp1").Cells.ClearContents
End sub 'don't put two end sub statments

3) Any columns you want set to text yuneed to format the column as text
before the files are read.  Once will be enough.

.Columns("B:C").numberformat = "@"

or

Sheets("temp1").Columns("B:C").numberformat = "@"

4) Here is a clear macro.  You can put it in a button Control.  If you put
the button on a worksheet then the macro has to be on the sheet where the
button is located but can clear other worksheets.  If you add the Button to a
ToolBar then it will go on ThisWorkbook.

sub Clear Data
Sheets("Temp1").cells.Clearcontents
Sheets("Data").cells.Clearcontents

end sub

5) I'll look into another Directory Browser.  Sometime I use the
GetOPenFileName to select first file and then extract the pathname of the
first file to get the folder.







...

read more »- Hide quoted text -

- Show quoted text -

Dear Joel,

The file browse is still there. I would like to change that.
Joel wrote:
3) Any columns you want set to text yuneed to format the column as
text
before the files are read. Once will be enough.
..Columns("B:C").numberformat = "@"
or
Sheets("temp1").Columns("B:C").numberformat = "@"

I wanted the values imported as text. Need this to happen at the time
of import. It is importing in general format.
Sinner wrote:
- The 2nd & 3rd column values in text file need to be imported as
text
cauz they start with 0. Also the numbers are 12 or more than 12
values
long like 111111112365172 etc.

I looked in VB help
something like TextToColumns, xlcolumndata, xltextformat approach.
The column specifiers can be in any order. If a given column specifier
is not present for a particular column in the input data, the column
is parsed with the General setting.

Hope u can help me with this.

I have placed entire code in module.

Thx

 

[Sinner]

Dear Joel,

The file browse is still there. I would like to change that.Joel wrote:

3) Any columns you want set to text yuneed to format the column as
text
before the files are read.  Once will be enough.
.Columns("B:C").numberformat = "@"
or
Sheets("temp1").Columns("B:C").numberformat = "@"

I wanted the values imported as text. Need this to happen at the time
of import. It is importing in general format.Sinner wrote:

- The 2nd & 3rd column values in text file need to be imported as
text
cauz they start with 0. Also the numbers are 12 or more than 12
values
long like 111111112365172 etc.

I looked in VB help
something like TextToColumns, xlcolumndata, xltextformat approach.
The column specifiers can be in any order. If a given column specifier
is not present for a particular column in the input data, the column
is parsed with the General setting.

Hope u can help me with this.

I have placed entire code in module.

Thx

Joel can below script be of any help?? Can you add some from this to
your script??

Sub Import_File()
Const iTitle = "Click on file to Import (hold down CTRL key to choose
multiple files)"

Const FilterList = "Text Files (*.txt*), *.txt*, All Files (*.*), *.*"


Dim Counter As Integer

Dim fnum As Variant

Application.ScreenUpdating = False

With Application

fnum = .GetOpenFilename(Title:=iTitle,
FileFilter:=FilterList, FilterIndex:=1, MultiSelect:=True)

If IsArray(fnum) = False Then Exit Sub

Counter = 1


While Counter <= UBound(fnum)

Workbooks.OpenText Filename:=fnum(Counter), Origin _
:=437, StartRow:=9, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True,
SemiColon:=False, Comma _
:=True, Space:=False, Other:=True, OtherChar:="|", FieldInfo:= _
Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2),
Array(5, 2), Array(6, 2), Array(7, 1), Array(8, 2), Array(9, 2),
Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2),
Array(15, 2)) _
, TrailingMinusNumbers:=True

Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
ActiveWindow.Zoom = 85


ActiveSheet.Select
ActiveSheet.Move Before:=Workbooks("Multi Data
Loader.xls").Sheets(1)

Counter = Counter + 1

Wend

End With

Application.ScreenUpdating = True

End Sub

 

[Joel]

IIn the query section of the code you need to add a .TextFileColumnDataTypes
with 1 = general and two = text. See below

With .QueryTables.Add( _
Connection:="TEXT;" & Folder & FName & "..txt", _
Destination:=Range("A1"))

.Name = "Test"
.FieldNames = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFileStartRow = 10
.TextFileParseType = xlDelimited
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With

 

[Sinner]

Dear Joel,

It worked : )

All files with column2 data import are ok.

All files with column3 data import push last value to load against
next category.
Example if I have 805 entries in column3 in file 2.txt category name
is AB then it is showing 804 against AB and pushing the last cell
value to BB category i.e. file 3.txt

The reason that I understand is that file 3.txt has no data in line
10. I have removed the file number entry in Temp sheet meaning that
only files with data will be loaded & it will not cater blank file.
All is well now. : )


Thx for your valuable time & much needed support.
Appreciate that.

 

[Sinner]

Ummmm Joel, with only code & the values in Temp sheet the xl file size
is less than 50KB.
After loading text files it grows to 2.28MB which is natural. Let's
suppose when I clear temp1 & data sheet, save & check size, its like
2.15MB????

Any idea whts going on? why is size there when there is no data??


Thx.

 

[Joel]

Excel is terrirble in recovering file size space when data is deleted. I
think Excel starts with a lot of default parameters and really doesn't assign
memory space to empty cells. when you add data to the worksheet these
defaults change as weel as data placed in the cells. When you delete the
data it doesn't set the properties back to the default values.

the only way I have found to get back the memory is to delete the worksheet
after the data is removed. Then add the worksheet back when you run another
macro.