Useful Excel Macro

Save worksheets as text files

Sub SaveSheetsAsTextFiles()
  Dim originalFileName As String
  Dim originalSheetName As String
  Dim anyWS As Worksheet
  Dim rootPath As String
  Dim newName As String
  Dim theYear As String
  Dim theMonth As String
  Dim theDay As String
  Dim whereAmI As String

  'you can assign a path to this like
  ' rootPath = "C:\folder1\folder2\folder3\"
  'but this uses path to folder where the
  'Excel file is stored
  rootPath = ActiveWorkbook.path
  If Right(rootPath, 1) <> Application.PathSeparator Then
    rootPath = rootPath & Application.PathSeparator
  End If
  originalFileName = ActiveWorkbook.FullName ' path and name!
  theYear = CStr(Format(Year(Now()), "0000")) ' 4 digit year
  theMonth = CStr(Format(Month(Now()), "00")) ' 2 digit month
  theDay = CStr(Format(Day(Now()), "00")) ' 2 digit day
  'remember where we are in the workbook
  whereAmI = ActiveSheet.Name
  'turn off alerts to the user
  Application.DisplayAlerts = False
  'prevent screen flickering and improve speed
  Application.ScreenUpdating = False
  For Each anyWS In ActiveWorkbook.Worksheets
    'must actually activate the sheet
    anyWS.Activate
    originalSheetName = ActiveSheet.Name
    'set up new name for the text file
    'you can easily change the sequence for the date portion
    'as set up all sheet names will be grouped together and
    'in date order from newest to oldest when viewed in file browser
    newName = rootPath & ActiveSheet.Name _
     & ".txt"
    'save the sheet as a TAB DELIMITED text file
    ActiveWorkbook.SaveAs _
     Filename:=newName, FileFormat:=xlText
    'change the sheet name back to its original name
    anyWS.Name = originalSheetName
  Next
  'and get the workbook back to its original name
  ActiveWorkbook.SaveAs _
   Filename:=originalFileName, FileFormat:=xlNormal
  'restore normal user alerting feature
  Application.DisplayAlerts = True
  'and return to the sheet you started on
  Worksheets(whereAmI).Activate
End Sub

Save worksheets as csv files

Sub ExportSheetsToCSV()
  Dim originalFileName As String
  Dim originalSheetName As String
  Dim anyWS As Worksheet
  Dim rootPath As String
  Dim newName As String
  Dim theYear As String
  Dim theMonth As String
  Dim theDay As String
  Dim whereAmI As String

  'you can assign a path to this like
  ' rootPath = "C:\folder1\folder2\folder3\"
  'but this uses path to folder where the
  'Excel file is stored
  rootPath = ActiveWorkbook.Path
  If Right(rootPath, 1) <> Application.PathSeparator Then
    rootPath = rootPath & Application.PathSeparator
  End If
  originalFileName = ActiveWorkbook.FullName ' path and name!
  theYear = CStr(Format(Year(Now()), "0000")) ' 4 digit year
  theMonth = CStr(Format(Month(Now()), "00")) ' 2 digit month
  theDay = CStr(Format(Day(Now()), "00")) ' 2 digit day
  'remember where we are in the workbook
  whereAmI = ActiveSheet.Name
  'turn off alerts to the user
  Application.DisplayAlerts = False
  'prevent screen flickering and improve speed
  Application.ScreenUpdating = False
  For Each anyWS In ActiveWorkbook.Worksheets
    'must actually activate the sheet
    anyWS.Activate
    originalSheetName = ActiveSheet.Name
    'set up new name for the text file
    'you can easily change the sequence for the date portion
    'as set up all sheet names will be grouped together and
    'in date order from newest to oldest when viewed in file browser
    newName = rootPath & "VO_CSVs_Ankur\" & ActiveSheet.Name _
     & ".csv"
    'save the sheet as a TAB DELIMITED text file
    ActiveWorkbook.SaveAs _
     Filename:=newName, FileFormat:=xlCSV
    'change the sheet name back to its original name
    anyWS.Name = originalSheetName
  Next
  'and get the workbook back to its original name
  ActiveWorkbook.SaveAs _
   Filename:=originalFileName, FileFormat:=xlNormal
  'restore normal user alerting feature
  Application.DisplayAlerts = True
  'and return to the sheet you started on
  Worksheets(whereAmI).Activate
End Sub

Replace all endline characters

Sub RemoveCarriageReturns()
    Dim MyRange As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    For Each MyRange In ActiveSheet.UsedRange
        If 0 < InStr(MyRange, Chr(13)) Then
            MyRange = Replace(MyRange, Chr(13), "")
        End If
    Next

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub