Solved

Create a macro to compile data in multiple .txt files into one .xls file - Part 2 (extraction)

Posted on 2011-09-05
4
222 Views
Last Modified: 2012-05-12
This question is related to
http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27256398.html

[Reason: I have already allocated the points to what has been requested and this is a follow up-add-ons to what i initially requested.]


To extract the following text line that starts with "Z" and add this as a comment at the end of the column.

For example,  see attached.
Example-10.03.11--more-than-1--A.txt

Result: This text should be placed in the final column.
 Example-2.7.10--1--Add-ons-.xls

There will always be a comment.
The comment is in text format. Usually starts with "Z" else, can be any alphabet.
The text length can vary but will always be in 1 line.
0
Comment
Question by:ceneiqe
  • 2
  • 2
4 Comments
 
LVL 23

Accepted Solution

by:
Michael74 earned 150 total points
ID: 36483428
I have added the requested functionality

Michael
Option Explicit

Sub getData()
   Dim FSO As New FileSystemObject
   Dim textFile As TextStream
   Dim textLine As String, folder As String, currentFile As String
   Dim currentRow As Long, count As Long
   Dim dateValue As Date
   Dim commentLine As Boolean

   ' Get file name from the user
   folder = getFolder
   If folder = "-1" Then Exit Sub
   
   'Set first file
   currentFile = Dir(folder & "\*.txt")
   
   Do While currentFile <> ""
   
      ' Get first empty row
      currentRow = Range("A" & Rows.count).End(xlUp).Row + 1
      
      Set textFile = FSO.OpenTextFile(currentFile)
      
      count = 0
      commentLine = False
      
      ' Loop through each line of text
      Do Until textFile.AtEndOfStream
         textLine = textFile.ReadLine
         If textLine <> "" Then
            If commentLine Then
               Range(COMMENT & currentRow).Value = Trim(textLine)
               currentRow = currentRow + 1
               commentLine = False
            ElseIf Left(textLine, 2) = "of" Then dateValue = CDate(Mid(textLine, 10, 11))
            ElseIf count = 1 And Left(textLine, 3) <> "---" Then
               Range(SA & currentRow).Value = Trim(Left(textLine, 3))
               Range(PACK & currentRow).Value = Trim(Mid(textLine, 4, 9))
               Range(ORDER & currentRow).Value = Trim(Mid(textLine, 14, 10))
               Range(LINE & currentRow).Value = Trim(Mid(textLine, 25, 5))
               Range(ITEM & currentRow).Value = Trim(Mid(textLine, 31, 25))
               Range(COL1 & currentRow).Value = Trim(Mid(textLine, 57, 2))
               Range(COL2 & currentRow).Value = Trim(Mid(textLine, 60, 3))
               Range(SASS & currentRow).Value = Trim(Mid(textLine, 64, 11))
               Range(REQ & currentRow).Value = Trim(Mid(textLine, 76, 3))
               Range(DEL & currentRow).Value = Trim(Mid(textLine, 80, 3))
               Range(DTE & currentRow).Value = dateValue
               commentLine = True
            ElseIf Left(textLine, 3) = "---" Then
               count = count + 1
               If count > 1 Then Exit Do
            End If
         End If
      Loop
      
      textFile.Close
      
      ' Get next file
      currentFile = Dir
   Loop
   
End Sub


Function getFolder() As String
   Dim fd As FileDialog
   Dim selection As Variant
   Dim fileName As String

   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
   With fd
      .AllowMultiSelect = False
      If .Show = -1 Then
         getFolder = .SelectedItems(1)
      Else
         getFolder = "-1"
      End If
   End With

End Function

Open in new window

Example-2.7.10--1--Add-ons-.xls
0
 

Author Comment

by:ceneiqe
ID: 36486467
Why is it that there is an error when  i copy the revised macro code into a new module sheet in the old workbook "Example-2.7.10--1-(1).xls" ?

I rename as"Sub getData1()" instead of "Sub getData()"

The word Comment is highlighted in  :
"Range(Comment & currentRow).Value = Trim(textLine)"

and the error message

Compile Error: Variable Not defined

0
 

Author Comment

by:ceneiqe
ID: 36486469
Did i do anything wrong ?

Other than that, if i use the worksheet "Example-2.7.10--1--Add-ons-.xls " alone and run, it works ok.
0
 
LVL 23

Expert Comment

by:Michael74
ID: 36487146
I have used constant values for my code. This means instead of refering to column "L" in the code eg
   Range("L"  & currentRow).Value = Trim(textLine)

I have declared that COMMENT is equal to "L" in the constants module ie

   Dim Const COMMENT as String = "L"

The value of doing this is that at a later date you can rearrage the output columns and instead of having to find every place in the code which refers to the columns you can just change the constant values and you are done.

Given this, to fix your problem please copy across the values in mdl_Constants into the old workbook

Michael
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

What is a Form List Box? (skip if you know this) The forms List Box is the alternative to the ActiveX list box. If you are using excel 2007, you first make sure you have a developer tab (click the Orb)->"Excel Options"->Popular->"Show Developer tab…
Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now