Using values in a cell to open other workbooks

[MrsE]

Hi,

I have different text files that I need to open in excel, run the same macro on and then save the file as an excel file using the same file name. I have the names of the files currently listed in a workbook as 3 columns - the path, the file name and then the extension. I've set it up this way because I'll need to use the macro many more times with different file names, paths and ext.

Can someone help me with the code to open up the different files and to save the file using the same path and name?

Example:

A1 - "011809" B1 - "C:\users\......" C1 ".txt"
A2 - "022109" B2 - "c:\users\......" C2 ".txt"
.....
A80 - "110109" ....

Thank you

 

[John Davis]

Hi,

I have different text files that I need to open in excel, run the same macro on and then save the file as an excel file using the same file name. I have the names of the files currently listed in a workbook as 3 columns - the path, the file name and then the extension. I've set it up this way because I'll need to use the macro many more times with different file names, paths and ext.

Can someone help me with the code to open up the different files and to save the file using the same path and name?

Example:

A1 - "011809" B1 - "C:\users\......" C1 ".txt"
A2 - "022109" B2 - "c:\users\......" C2 ".txt"
.....
A80 - "110109" ....

Thank you

This code will open a txt file using ranges of the active workbook, color the background, and then save and close as an xls file. Perhaps this can get you started.

Sub MrsE()
'
Dim curbook As Workbook
Dim x As String
Dim y As String

With Application

    .DisplayAlerts = False
    .ScreenUpdating = False
    
End With

Set curbook = ActiveWorkbook

y = Range("B1").Text & Range("A1").Text

x = y & Range("C1").Text

'
    Workbooks.OpenText Filename:=x, Origin:= _
        437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
        
    Cells.Interior.ColorIndex = 6
    
    ActiveWorkbook.SaveAs Filename:=y & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    
    ActiveWindow.Close

With Application

    .DisplayAlerts = False
    .ScreenUpdating = False
    
End With

End Sub

 

[MrsE]

Thank you for the response - I know it's simple, but I'm not figuring it out to have the macro continue until the end of the list of files.

So


y = Range("B1").Text & Range("A1").Text x = y & Range("C1").Text

then becomes y = Range ("B2").text & Range ("A2").Text
.....

until the end.
</pre>

 

[John Davis]

Thank you for the response - I know it's simple, but I'm not figuring it out to have the macro continue until the end of the list of files.

So


y = Range("B1").Text & Range("A1").Text x = y & Range("C1").Text

then becomes y = Range ("B2").text & Range ("A2").Text
.....

until the end.
</pre>

That was a sample. You have to incorporate a loop to continue down the cells.

Sub MrsE()
'
Dim curbook As Workbook
Dim x As String
Dim y As String
Dim i As Long
Dim lr As Long


With Application

    .DisplayAlerts = False
    .ScreenUpdating = False
    
End With

Set curbook = ActiveWorkbook

lr = Cells(Rows.Count, 1).End(xlUp).Row

For i = lr To 2 Step -1

y = Range("B" & i).Text & Range("A" & i).Text

x = y & Range("C" & i).Text

'
    Workbooks.OpenText Filename:=x, Origin:= _
        437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
        
    Cells.Interior.ColorIndex = 6
    
    ActiveWorkbook.SaveAs Filename:=y & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    
    ActiveWindow.Close
    
curbook.Activate

Next i

With Application

    .DisplayAlerts = True
    .ScreenUpdating = True    
End With

End Sub