To begin with I'm not an expert in VBA scripts or coding, but what i do every day is receive excel files where I'm not supposed to edit the data in them only to clean them (also the sheets in all the excel files) and save them as a Unicode text file, what has to be done is use the function clean (preferably on all columns) remove hard spacing and anything causing line breaks and the scientific "E+" notations without affecting the data in the columns(this could range from dates to values and descriptions)
I have created this but it freezes on big excel files and also only does the clean and save parts i think so its not always 100% clean
Sub CleanAndSaveEachSheetAsUnicodeText()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim lastRow As Long
Dim lastCol As Long
Dim originalPath As String
Dim fileName As String
Dim data As Variant
Dim i As Long, j As Long
' Disable screen updating and automatic calculation
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Loop through each worksheet in the workbook
For Each ws In ThisWorkbook.Sheets
' Find the last row and last column with data in the worksheet
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' Load data into an array
data = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value
' Loop through the array to apply the CLEAN function
For i = 1 To UBound(data, 1)
For j = 1 To UBound(data, 2)
data(i, j) = Application.Clean(data(i, j))
Next j
Next i
' Write cleaned data back to the worksheet
ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value = data
' Get the original file path and name
originalPath = ThisWorkbook.FullName
' Extract the sheet name
fileName = ws.Name
' Save the worksheet as Unicode text in the same folder as the original file
Dim filePath As String
filePath = Application.GetSaveAsFilename(InitialFileName:=fileName, FileFilter:="Unicode Text (*.txt), *.txt", Title:="Save As")
If filePath <> "False" Then
' Save as Unicode text
ws.SaveAs Filename:=filePath, FileFormat:=xlUnicodeText
End If
Next ws
' Enable screen updating and automatic calculation
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
If someone can help me through it and fix the code for me I would really appreciate it
It is not necessary to loop over individual cells to apply
CLEANfunction. Similarly you can convert hard spaceschr(160)to common ones.Assuming that cells with scientific notation are not specifically formatted (
.Numberformat = "General"), to remove this notation should be enough to apply columns autofit.Code fragment with proposed improvements: