copy specific worksheet in xlsx as text file

[cmccabe1]

I am trying to convert all ~200 xlsx files txt using the below vb. In each .xlsx file there is a worksheet with "analysis" in the name that I am trying to copy to Const Filepath So in that directory there will be 200 txt files all from the "analysis" sheet in the .xlsx files. The vb runs but nothing happens and I need some expert help getting this to work. I have been trying for days with no luck. Thank you .

VB

Private Sub CommandButton1_Click()
Dim fName As String, fPath As String, wb As Workbook


Const Filepath  As String = "C:\Users\cmccabe\Desktop\folder"


fPath = "C:\Users\cmccabe\Desktop\epilepsy\"
fName = Dir(fPath & "*analysis*.xlsx")
Do While fName <> ""
    Set wb = Workbooks.Open(fPath & fName)
    wb.SaveAs Left(fName, Len(fName) - 5) & ".txt", FileFormat:=xlText
    fName = Dir
    Filename = Filepath & "\" & Left(oFile, InStrRev(oFile, ".")) & "txt"


                Open Filename For Output Access Write As #1
                Print #1, Text
                Close #1
 Loop
 End Sub

[Kevin#]

Hi CMC
Try this
I have amended as follows
- added the Filepath to the line beginning wb.SaveAs...(you may find that the text files were being saved to your default folder)
- added a line to Close each newly created text file
- removed the last 4 lines of code

kevin

Private Sub CommandButton1_Click()
    Dim fName As String, fPath As String, wb As Workbook
    Const Filepath  As String = "C:\Users\cmccabe\Desktop\folder"
    fPath = "C:\Users\cmccabe\Desktop\epilepsy\"
    fName = Dir(fPath & "*analysis*.xlsx")
    Do While fName <> ""
        Set wb = Workbooks.Open(fPath & fName)
        wb.SaveAs Filepath & "\" & Left(fName, Len(fName) - 5) & ".txt", FileFormat:=xlText
        wb.Close SaveChanges:=False
        fName = Dir
    Loop


End Sub

[cmccabe1]

That works for 1/4 of the files... is there a way that another command button can be used that is similar except that for a different file name (sample) and if it is that file name it opens and copies a specific worksheet (test) in that .xlsx to the new directory? Thank you .

Private Sub CommandButton1_Click() 
    Dim fName As String, fPath As String, wb As Workbook 
    Const Filepath  As String = "C:\Users\cmccabe\Desktop\folder" 
    fPath = "C:\Users\cmccabe\Desktop\epilepsy\" 
    fName = Dir(fPath & "*sample*.xlsx") 
    wname = Dir(fPath & "*sample*.xlsx & "sheets("test")")
    Do While fName <> "" 
        Set wb = Workbooks.Open(fPath & wName) 
        wb.SaveAs Filepath & "\" & Left(fName, Len(fName) - 5) & ".txt", FileFormat:=xlText 
        wb.Close SaveChanges:=False 
        fName = Dir 
    Loop 
     
     
End Sub

[Kevin#]

You are welcome

Just to make sure I understand your question I have 3 questions

Are there several files with "sample" in their name?
Is there is a worksheet called "test" in each of these files?
Do you want to save each worksheet called "test" as a separate text file to C:\Users\cmccabe\Desktop\folder ?

[cmccabe1]

Are there several files with "sample" in their name?

Yes, there are ~125

Is there is a worksheet called "test" in each of these files

Yes, the worksheet test appears somewhere in each of these files ( could be *test or *test* or test*)

Do you want to save each worksheet called "test" as a separate text file to C:\Users\cmccabe\Desktop\folder

Yes, each new test worksheet will be saved in the new directory

Thank you very much for your help .

[Kevin#]

Try this

VBA will overwrite previous versions of the text files - is this what you want?
(Application.DisplayAlerts set to FALSE)

The code assumes that there is always a sheet named "test" in each "sample".xlsx file. If a workbook is opened that does not contain this sheet, VBA will stop running, leaving the workbook open. The code will fail at this line:

Set ws = Sheets("test")

How do yo want to handle this?
(could force a blank worksheet to be created OR check all files before saving any of the "test" sheets OR set up error handling so that the error is ignored and VBA moves onto next file etc...)

Kevin

Private Sub CommandButton2_Click()


    Application.DisplayAlerts = False
    Dim fName As String, fPath As String, wb As Workbook
    Dim ws As Worksheet
    Const Filepath  As String = "C:\Users\cmccabe\Desktop\folder"
    fPath = "C:\Users\cmccabe\Desktop\epilepsy\"
    fName = Dir(fPath & "*sample*.xlsx")
    Do While fName <> ""
        Set wb = Workbooks.Open(fPath & fName)
        Set ws = Sheets("test")
        ws.Copy
        wb.SaveAs Filepath & "\" & Left(fName, Len(fName) - 5) & ".txt", FileFormat:=xlText
      
        wb.Close SaveChanges:=False
        ActiveWorkbook.Close SaveChanges:=False
        
        fName = Dir
    Loop
    Application.DisplayAlerts = True

End Sub

PS - there are 2 files to close each time - the VBA creates an extra one for each "test" sheet

[cmccabe1]

If the sheet "test" is not found then maybe ignoring the error is best. Good catch on the display alerts, I do not want to replace or remove any files. Thanks again .

[Kevin#]

Hi CMC
Attached is amended code which includes a check to see if sheet "test" exists. If it does not exist, a message box appears containing the name of the .xlsx file and then the VBA closes the file and carries on as before.

The lines Application.ScreenUpdating = False/True have been added to stop the screen refreshing until the end

You said

I do not want to replace or remove any files

So I have removed the lines Application.DisplayAlerts = False/True - so you will now get a message asking you to confirm that you want to overwrite an existing TEXT file.

Kevin

Private Sub CommandButton2_Click() 
    
    Application.ScreenUpdating = False
    Dim fName As String, fPath As String, wb As Workbook
    Dim ws As Worksheet
    Const Filepath  As String = "C:\Users\cmccabe\Desktop\folder"
    fPath = "C:\Users\cmccabe\Desktop\epilepsy\"
    fName = Dir(fPath & "*sample*.xlsx")
    
    Do While fName <> ""
        Set wb = Workbooks.Open(fPath & fName)
'test for existence of sheet named "test"
            test = 0
                For Each ws In Worksheets
                    If ws.Name = "test" Then
                    test = 1
                    Else
                    'do nothing
                    End If
                Next
            If test = 0 Then
'close the workbook if "test" does not exist
                MsgBox wb.Name & vbNewLine & "does not contain sheet TEST"
                ActiveWorkbook.Close SaveChanges:=False
            Else
'save sheet "test" as a text file (ie if "test" does exist)
                Set ws = Sheets("test")
                ws.Copy
                wb.SaveAs Filepath & "\" & Left(fName, Len(fName) - 5) & ".txt", FileFormat:=xlText
                wb.Close SaveChanges:=False
                ActiveWorkbook.Close SaveChanges:=False
            End If
        fName = Dir
    Loop
    Application.ScreenUpdating = True

End Sub

[Kevin#]

Here is a more elegant (ie faster!) way of checking for existence of sheet "test".
The line If Evaluate("ISREF('test'!A1)") simply verifies the existence of cell A1 in sheet named "test"(previous solution looped through all the sheets in workbook looking for sheet named "test")

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False
    Dim fName As String, fPath As String, wb As Workbook
    Dim ws As Worksheet
    Const Filepath  As String = "C:\Users\cmccabe\Desktop\folder"
    fPath = "C:\Users\cmccabe\Desktop\epilepsy\"
    fName = Dir(fPath & "*sample*.xlsx")
    
    Do While fName <> ""
        Set wb = Workbooks.Open(fPath & fName)
'test for existence of sheet named "test"
            If Evaluate("ISREF('test'!A1)") Then
'save sheet "test" as a text file (ie if "test" does exist)
                Set ws = Sheets("test")
                ws.Copy
                wb.SaveAs Filepath & "\" & Left(fName, Len(fName) - 5) & ".txt", FileFormat:=xlText
                wb.Close SaveChanges:=False
                ActiveWorkbook.Close SaveChanges:=False
            Else
'close the workbook if "test" does not exist
                MsgBox wb.Name & vbNewLine & "does not contain sheet TEST"
                ActiveWorkbook.Close SaveChanges:=False
            End If
        fName = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

[cmccabe1]

if the word "test" appears somewhere in the name of the worksheet (sample_test or test_sample), can a wildcard be used?

[If Evaluate("ISREF('*test*'!A1)") Then

Thank you .

[Kevin#]

No - we cannot use wildcards here.
And that could be dangerous - "test" could appear inadvertently elsewhere as part of a different sheet name - and that would lead to errors in identifying the correct sheet!
Question - do ALL the "test" sheet names that you need to save as text files either start with "test" OR end with "test" with no other possibilities? And is there only one sheet in each workbook fulfilling that criteria?

[cmccabe1]

For the sheet names in ~ half "test" appears at the beginning but for the other half "test" appears at the end.

Maybe two separate VBA's? Thank you very much

[Kevin#]

I will think about this overnight (after celebrating the new year!) and get back to you tomorrow.

It is easy to search for text strings within Sheet Names using VBA, but we need to be careful not to inadvertently allow the wrong sheet to be selected. And there are other complications like upper case/lower case etc to build in.

Question Are all the sheets called either "sample_test" or "test_sample"?
If so, the solution is easy - we search for both one after the other within the same macro

HAPPY NEW YEAR

kevin

[cmccabe1]

HAPPY NEW YEAR and enjoy your evening of celebration

I think those are the only possibilities but I have to double check as the data is very unorganized and hard to read. Thanks again

edit: it looks like there is a number in front of the text that changes in each sheet. 1234test_sample or 4567sample_test

[Kevin#]

ok.
So can you confirm that
- the workbooks all contain EITHER the string "test_sample" or "sample_test"
- there is only ONE sheet in each workbook containing that string
- the letters are consistently lower case

and now the beer really is calling very loudly.......

[cmccabe1]

so the strings are either "test_sample" or "sample_test" with a number in front that changes each file
there is only 1 worksheet with that string in it
looks like the case is not consistent as sometimes it is test_sample and other times it is Test_Sample... the workbook name is also not consistent (Sample sometimes other times sample).

I'm with you on the beer calling Have a great night and happy new year!

[Kevin#]

Code modified to search for strings "test_sample" or "sample_test" in worksheet name (regardless of case)

How long does this take to run?

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
    Dim fName As String, fPath As String, wb As Workbook
    Dim ws As Worksheet
    Dim sName As String
    Const Filepath  As String = "C:\Users\cmccabe\Desktop\folder"
    fPath = "C:\Users\cmccabe\Desktop\epilepsy\"
    fName = Dir(fPath & "*sample*.xlsx")
    Do While fName <> ""
    
        Set wb = Workbooks.Open(fPath & fName)
'test for existence of sheet with name including string "test_sample" or "sample_test"
            test = 0
                For Each ws In Worksheets
                    If LCase(ws.Name) Like "*test_sample*" Or LCase(ws.Name) Like "*sample_test*" Then
                        test = 1
                        sName = ws.Name
                    Else
                    'do nothing
                    End If
                Next
            If test = 0 Then
                MsgBox wb.Name & vbNewLine & "does not contain sheet test_sample or sample_test"
                ActiveWorkbook.Close SaveChanges:=False
            Else
                Set ws = Sheets(sName)
                ws.Copy
                wb.SaveAs Filepath & "\" & Left(fName, Len(fName) - 5) & ".txt", FileFormat:=xlText
                wb.Close SaveChanges:=False
                ActiveWorkbook.Close SaveChanges:=False
            End If
        fName = Dir
    Loop
Application.ScreenUpdating = True
End Sub

[cmccabe1]

Happy New Year and Thank you very much, that worked perfectly and took less than 5 minutes .

[Kevin#]

Glad all working well.
If you want to get rid of the inconsistencies (viz upper and lower case sheet names) , try this which converts all worksheet names to lower case.
Suggest you copy the original files to a test folder to experiment!

Sub RenameAllSheetsToLowerCase()
Application.ScreenUpdating = False
    Dim fName As String, fPath As String, wb As Workbook, ws As Worksheet
    fPath = "C:\Users\cmccabe\Desktop\epilepsy\" 'MODIFY to relevant folder***
    fName = Dir(fPath & "*sample*.xlsx") 'MODIFY to relevant file name ***
    Do While fName <> ""
        Set wb = Workbooks.Open(fPath & fName)
            For Each ws In Worksheets
                ws.Name = LCase(ws.Name)
            Next
        wb.Close SaveChanges:=True
        fName = Dir
    Loop
Application.ScreenUpdating = True
End Sub

[cmccabe1]

In the attached file (all 133 other files are similar) can only column headers Chr, Start, End, Ref, Alt be extracted from each worksheet. All others are not needed. The problem is that those headers appear in different spots but the header name is always that. The vba as is works great and creates a text file from the entire xlsx. So in the modified version instead of saving the entire xlsx as a text it would only save those 5 column headers for each of the 133 files. Thank you .