excel VBA that will save a file as a .txt format

[BORUCH]

hi all

i would like a excel vba that saves the active sheet as a .txt file format, in a certain directory, based on a input box with restrictions.

#1 It must be 5 characters
#2 It must be either 2 letters and 3 numbers or 4 letters and 1 number

Also i would like the default value of the input box to be cell A1 on the first worksheet of the workbook.

Any help is greatly appreciated

thanks

 

[BORUCH]

Any help is appreciated

 

[BORUCH]

i need something like a loop

 

[Mortiray]

hi all

i would like a excel vba that saves the active sheet as a .txt file format, in a certain directory, based on a input box with restrictions.

#1 It must be 5 characters
#2 It must be either 2 letters and 3 numbers or 4 letters and 1 number

Also i would like the default value of the input box to be cell A1 on the first worksheet of the workbook.

Any help is greatly appreciated

thanks

Do you want this laid out like a CSV file, or do you just want each valid value on its own line?

 

[BORUCH]

Do you want this laid out like a CSV file, or do you just want each valid value on its own line?

it should save it as .txt whatever format that is

 

[Mortiray]

it should save it as .txt whatever format that is

Make a new module, and copy-paste this code into it. The first two lines are for you to edit.

'Edit these to what you want
Const OutputFileName As String = "output.txt" 'The name of your output file
Const FilePathCellAddress As String = "$A$1" 'Where the file path is stored in your sheet

'Tests if a character is a number
Private Function IsNum(ByVal InputVal As String) As Boolean
    IsNum = Asc(InputVal) >= 48 And Asc(InputVal) <= 57
End Function

'Tests if a character is a letter
Private Function IsLtr(ByVal InputVal As String) As Boolean
    IsLtr = (Asc(InputVal) >= 65 And Asc(InputVal) <= 90) Or (Asc(InputVal) >= 97 And Asc(InputVal) <= 122)
End Function

Private Function MeetsRequirements(ByVal InputVal As String) As Boolean
   
    'Test the String Composition (either AA### or AAAA#, where A is a letter and # is a number) and the string length.
    If Len(InputVal) = 5 _
    Then MeetsRequirements = ( _
        IsLtr(Mid(InputVal, 1, 1)) And _
        IsLtr(Mid(InputVal, 2, 1)) And _
        IsNum(Mid(InputVal, 3, 1)) And _
        IsNum(Mid(InputVal, 4, 1)) And _
        IsNum(Mid(InputVal, 5, 1)) _
        ) Or ( _
        IsLtr(Mid(InputVal, 1, 1)) And _
        IsLtr(Mid(InputVal, 2, 1)) And _
        IsLtr(Mid(InputVal, 3, 1)) And _
        IsLtr(Mid(InputVal, 4, 1)) And _
        IsNum(Mid(InputVal, 5, 1)) _
        ) _
    Else: MeetsRequirements = False
    
End Function

'This is the macro you'll run in your sheet
Sub Save_Active_Sheet_As_Text()
    Dim EndRow As Long
    Dim EndCol As Long
    
    Dim FilePath As String
    FilePath = Range("$A$1").Value
    
    With ActiveSheet.Cells
        EndRow = .Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        EndCol = .Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    End With
    
    Dim FileNum As Integer
    FileNum = FreeFile
     
    Open FilePath & OutputFileName For Output As FileNum
    
    Dim CurVal As String
    Dim CurRow As Long
    Dim CurCol As Long
    For CurCol = 1 To EndCol
        For CurRow = 1 To EndRow
            CurVal = Cells(CurRow, CurCol).Value
            If MeetsRequirements(CurVal) Then Print #FileNum, CurVal
        Next CurRow
    Next CurCol
    
    Close FileNum
    
    MsgBox "File " & OutputFileName & " successfully saved in " & FilePath, vbInformation, "Success"
End Sub

 

[BORUCH]

Make a new module, and copy-paste this code into it. The first two lines are for you to edit.

'Edit these to what you want
Const OutputFileName As String = "output.txt" 'The name of your output file
Const FilePathCellAddress As String = "$A$1" 'Where the file path is stored in your sheet

'Tests if a character is a number
Private Function IsNum(ByVal InputVal As String) As Boolean
    IsNum = Asc(InputVal) >= 48 And Asc(InputVal) <= 57
End Function

'Tests if a character is a letter
Private Function IsLtr(ByVal InputVal As String) As Boolean
    IsLtr = (Asc(InputVal) >= 65 And Asc(InputVal) <= 90) Or (Asc(InputVal) >= 97 And Asc(InputVal) <= 122)
End Function

Private Function MeetsRequirements(ByVal InputVal As String) As Boolean
 
    'Test the String Composition (either AA### or AAAA#, where A is a letter and # is a number) and the string length.
    If Len(InputVal) = 5 _
    Then MeetsRequirements = ( _
        IsLtr(Mid(InputVal, 1, 1)) And _
        IsLtr(Mid(InputVal, 2, 1)) And _
        IsNum(Mid(InputVal, 3, 1)) And _
        IsNum(Mid(InputVal, 4, 1)) And _
        IsNum(Mid(InputVal, 5, 1)) _
        ) Or ( _
        IsLtr(Mid(InputVal, 1, 1)) And _
        IsLtr(Mid(InputVal, 2, 1)) And _
        IsLtr(Mid(InputVal, 3, 1)) And _
        IsLtr(Mid(InputVal, 4, 1)) And _
        IsNum(Mid(InputVal, 5, 1)) _
        ) _
    Else: MeetsRequirements = False
  
End Function

'This is the macro you'll run in your sheet
Sub Save_Active_Sheet_As_Text()
    Dim EndRow As Long
    Dim EndCol As Long
  
    Dim FilePath As String
    FilePath = Range("$A$1").Value
  
    With ActiveSheet.Cells
        EndRow = .Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        EndCol = .Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    End With
  
    Dim FileNum As Integer
    FileNum = FreeFile
   
    Open FilePath & OutputFileName For Output As FileNum
  
    Dim CurVal As String
    Dim CurRow As Long
    Dim CurCol As Long
    For CurCol = 1 To EndCol
        For CurRow = 1 To EndRow
            CurVal = Cells(CurRow, CurCol).Value
            If MeetsRequirements(CurVal) Then Print #FileNum, CurVal
        Next CurRow
    Next CurCol
  
    Close FileNum
  
    MsgBox "File " & OutputFileName & " successfully saved in " & FilePath, vbInformation, "Success"
End Sub

Hi
my file name is not output.txt
it should be coming from an input box
i would prefer something simple like an input box with a pattern restrictions with a loop
then a simple code like
ActiveWorkbook.SaveAs FileName:= _
"C:\Users\aaa\Documents\" &....