Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Visual Basic/Excel 1

Status
Not open for further replies.

gmc5135

Technical User
May 27, 2011
10
US
I apologize for the lengthy task, but I have run into a tight spot and my boss is on my butt to do this, quite frankly i've never used visual basic before. I understand your time is valuable so even hints or parts of the code would be appreciated, but if you can do the whole thing i'd love you forever.

Title
Labels
Averages
Measured
AA 1 25.0
8 4 6 3 2 4 5 7 3 2
AB 1 50.0
7 1 2 5 4 6 3 9 8 7
AC 1 75.0
7 8 6 5 4 2 1 3 8 7
BA 1 100.0
1 2 3 4 5 6 7 8 9 1
BB 1 125.0
9 6 6 4 1 5 2 3 4 3
BC 1 150.0
3 2 1 6 5 4 9 8 7 6
CA 1 175.0
3 6 9 8 5 2 1 4 7 8
CB 1 200.0
2 5 8 7 4 1 3 6 9 8
CC 1 225.0
6 5 4 1 2 3 9 8 7 6
DA 1 230.0
1 9 3 7 8 2 6 4 5 5
DB 2 25.0
1 5 9 6 2 3 4 8 7 8
DC 2 50.0
9 8 5 6 3 2 1 4 7 8

The first sheet in excel will have the user enter a directory name and which groups to analyze(the groups will be defined by the two letters and the number at the right of that line such as CB 200.0 or BA 100.0). Each directory will have approximately 25 text files. I need a Visual Basic code to open the directory defined by user, then open each text file within the directory, and put whatever groups were selected(same groups for each file within the directory) into a worksheet. The only values I want put into the worksheet are the first and second values in the line below the group. So for CC 225.0 I want 6 and 5 put into excel.

Thank you all so much in advance for taking the time to look at this. Hopefully we can figure this bad boy out.
 
What version of Excel are you using?

Concerning the text files, what format is the data in that you need to extract?
 



Hi,

This is not a 'hire a programmer' forum.

It is Tek-Tips.

We help people with specific problems, not an entire application from scratch, UNLESS you care to try to tackle that task YOURSELF, with tips from us.

Ball's in your court.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
jges: I am using excel 2007. The text is in WordPad and looks just like i have typed it above. The first four lines need skipped because they just contain file titles and other useless information.

SkipVought: If you read the original post it states, "I understand your time is valuable so even hints or parts of the code would be appreciated." If you don't wish to give me hints or parts of the code, then don't, and i apologize for wasting your time.

gmstrong: I spent all of friday reading through tutorials so I have not gotten anything so far. Hopefully today I can get it started. I'll post it when I make progress.
 



Please post whatever code you have, with particular attention to problem areas.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
This is about all I could figure out so far. I can probably figure out the reading each individual text and extracting data from it. I'm more troubled by the opening the directory, and running each text file within that directory.



Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim WDir As Variant
Sheets("SRWM").Select
Range("A4").Select
If Worksheets("Info").Cells(1, 1).Value = "" Then
WDir = CurDir
Else
WDir = Worksheets("Info").Cells(1, 1).Value
End If
ChDrive Left(WDir, 1)
ChDir WDir
Workbooks.OpenText Filename:="data.txt", Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
Space:=True, Other:=False
 


opening the directory, and running each text file within that directory
Code:
    Dim oFSO, oFile, folderspec As String
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    
    folderspec = "C:\"
    
    For Each oFile In oFSO.GetFolder(folderspec).Files
        If oFile.Type = "Text Document" Then
            Debug.Print oFile.Path
        End If
    Next


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Thanks a lot Skip, I appreciate the help. That'll take care of most of my problems.
 
This is the code i have gotten so far, however i still have a problem:
I've only gotten it to run for the one .txt and not all of them. This will need to be changed for the copying and pasting as well as the closing of the .txt.

Any help is appreciated

Code:
Sub Macro2()
Dim oFSO, oFile, folderspec As String
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    folderspec = "C:\"
    For Each oFile In oFSO.GetFolder(folderspec).Files
        If oFile.Type = "Text Document" Then
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\carsongm\Desktop\SRWM results\inp15_srwm_N31.txt", _
        Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
        TrailingMinusNumbers:=True
    Range("B5:D142").Select
    Selection.Copy
    Windows("SRWM 30% Flux Map.xlsm").Activate
    Sheets("Formula").Select
    Range("A1").Select
    Selection.Insert Shift:=xlDown
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Windows("inp15_srwm_N31.txt").Activate
    ActiveWindow.Close
          End If
    Next
End Sub
 


Rather than using the Workbooks Open n=method, I'd suggest using the Data > Get External Data From Text method. This will import the data into your workbook in the active sheet. It does not open another workbook.

But you're on the right path.

In general and abbreviated for emphasis...
Code:
    For Each oFile In oFSO.GetFolder(folderspec).Files
        If oFile.Type = "Text Document" Then
            Workbooks.OpenText _
                Filename:=[b]oFile.Path[/b]
        End If
    Next


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
where it says "Filename:=" should i put in a filename from the folder or leave it as oFile.Path? because when i put it as a filename from the folder it only runs that particular text.
 


I am not sure what you mean. The oFile.Path IS one of the files in the folder. As the loop processes, each of the files is opened. Of course, you'll want to do some processing before NEXT.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
when i run this code it says that 'oFile.Path' could not be found

Code:
Sub Macro2()
Dim oFSO, oFile, folderspec As String
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    folderspec = "C:\Documents and Settings\carsongm\Desktop\SRWM results"
    For Each oFile In oFSO.GetFolder(folderspec).Files
        If oFile.Type = "Text Document" Then
    Workbooks.OpenText Filename:="oFile.Path", _
        Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
        TrailingMinusNumbers:=True
    Range("B5:D142").Select
    Selection.Copy
    Windows("SRWM 30% Flux Map.xlsm").Activate
    Sheets("Formula").Select
    Range("A1").Select
    Selection.Insert Shift:=xlDown
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Windows("inp15_srwm_N31.txt").Activate
    ActiveWindow.Close
          End If
    Next
End Sub
 


NO QUOTES!!!!
Code:
Workbooks.OpenText Filename:=oFile.Path, .......

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Finally got it!!! Everything works perfectly. I really can't thank you enough skip. Much appreciation
 


Sorry if we got on on the wrong foot.

Glad to see you take the bull by the horns.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Last little problem. I'm trying to get the macro to look in the folder that is in cell B2. It worked when i had folderspec="folder path" but i want it to be able to do whatever folder the user types in B2.

Thanks in advance.

Code:
Sub Macro2()
Dim oFSO, oFile, folderspec As String
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    folderspec = "Worksheets(Input).Range(B2)"
    For Each oFile In oFSO.GetFolder(folderspec).Files
        If oFile.Type = "Text Document" Then
    Workbooks.OpenText Filename:=oFile.Path, _
        Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)), _
        TrailingMinusNumbers:=True
    Range("B5:D142").Select
    Selection.Copy
    Windows("SRWM 30% Flux Map Formula.xlsm").Activate
    Sheets("TempStorage").Select
    Range("A1").Select
    Selection.Insert Shift:=xlDown
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Windows(oFile.Name).Activate
    ActiveWindow.Close
          End If
    Next
    Columns("A:C").Select
    Selection.Copy
    Sheets("Formula").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub
 
Replace this:
folderspec = "Worksheets(Input).Range(B2)"
with this:
folderspec = Worksheets(Input).Range("B2")

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
I had to add quotes around input as well but i got it. thanks a lot for the help
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top