VBA script/clean/remove hard spacing/remove scientific "E+" notations/and save as Unicode text

62 views Asked by At

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

1

There are 1 answers

4
MGonet On

It is not necessary to loop over individual cells to apply CLEAN function. Similarly you can convert hard spaces chr(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:

 ' Get the original file path and name
originalPath = ThisWorkbook.FullName

' Loop through each worksheet in the workbook
For Each ws In ThisWorkbook.Sheets

' Load data into an array
data = ws.UsedRange.Value

' apply the CLEAN function
 data = Application.Clean(data)

'  apply SUBSTITUTE to change chr(160) to chr(32)
 data = Application.Substitute(data, Chr(160), " ")

' Write cleaned data back to the worksheet
  ws.UsedRange.Value = data

' Columns AutoFit
  ws.Columns.AutoFit