FixENTERS_File

Removes [Enter]s from imported csv file into Excel worksheet.
Smart enough to detect that there were [Enter]s inside certain column in worksheet that was imported from a CSV file.
Just need to specify columns where [Enter]s are expected

CodeFunctionName
What is this?

Public

Tested

Original Work
Sub FixENTERS_File(ForFile, Optional Colo = "Step3_CSV_Spc_ColCol6")
' After we open, we check for ENTER in columns found in "Step3_CSVCol_Col22"
Fiii = SettingRead("Step3_File" & ForFile)
Cols22 = SettingRead(Colo)
Application.Calculation = xlCalculationManual
' We first remove blank lines
Max1 = Workbooks(Fiii).Worksheets(1).Range("A1").CurrentRegion.Rows.Count
Max2 = WorksheetFunction.CountA(Workbooks(Fiii).Worksheets(1).Range("A1").EntireColumn)
Max3 = WorksheetFunction.Count(Workbooks(Fiii).Worksheets(1).Range("A1").EntireColumn)
BLs = 0
If Max1 < > Max2 Then ' We got blank lines
X1 = 1
Do Until X1 > Max1
AllRs = WorksheetFunction.CountA(Workbooks(Fiii).Worksheets(1).Range("A1").Offset(X1).EntireRow)
If AllRs = 0 Then
BLs = BLs + 1
If BLs > 50 Then Exit Do
Workbooks(Fiii).Worksheets(1).Range("A1").Offset(X1).EntireRow.Delete
X1 = X1 - 1
Max1 = Workbooks(Fiii).Worksheets(1).Range("A1").CurrentRegion.Rows.Count
Else
BLs = 0
End If
X1 = X1 + 1
Loop
End If
X1 = 1
Max1 = Workbooks(Fiii).Worksheets(1).Range("A1").CurrentRegion.Rows.Count
Do
ID2 = Workbooks(Fiii).Worksheets(1).Range("A" & X1 + 1).Value
ID3 = Workbooks(Fiii).Worksheets(1).Range("A" & X1 + 2).Value
ID4 = Workbooks(Fiii).Worksheets(1).Range("A" & X1 + 3).Value
ID5 = Workbooks(Fiii).Worksheets(1).Range("A" & X1 + 4).Value
ID6 = Workbooks(Fiii).Worksheets(1).Range("A" & X1 + 5).Value
For Each Coll In Split(Cols22, "+")
Coll = Trim(Coll)
If Coll = "" Then GoTo NextC
Where1 = Workbooks(Fiii).Worksheets(1).Range(Coll & X1).Value
ColsAfter = WorksheetFunction.CountA(Workbooks(Fiii).Worksheets(1).Range(Range(Coll & X1).Offset(, 1).Address, Range(Coll & X1).Offset(, 150).Address))
If (Not IsNumeric(ID2) Or ID2 = "") And ColsAfter = 0 Then
' We found a line with enter
' We combine Comments, and bring up below row
Where2 = Where1
If ID2 > "" Then ID2 = "." & ID2
Where2 = Where1 & ID2
RowFound = 1
RowUp2 = WorksheetFunction.CountA(Workbooks(Fiii).Worksheets(1).Range(Coll & X1).Offset(1).EntireRow)
If Not IsNumeric(ID3) Then
Where2 = Where1 & ID2 & "." & ID3
RowFound = 2
RowUp2 = WorksheetFunction.CountA(Workbooks(Fiii).Worksheets(1).Range(Coll & X1).Offset(RowFound).EntireRow)
If Not IsNumeric(ID4) Then
Where2 = Where1 & ID2 & "." & ID3 & "." & ID4
RowFound = 3
RowUp2 = WorksheetFunction.CountA(Workbooks(Fiii).Worksheets(1).Range(Coll & X1).Offset(RowFound).EntireRow)
If Not IsNumeric(ID5) Then
Where2 = Where1 & ID2 & "." & ID3 & "." & ID4 & "." & ID5
RowFound = 4
RowUp2 = WorksheetFunction.CountA(Workbooks(Fiii).Worksheets(1).Range(Coll & X1).Offset(RowFound).EntireRow)
If Not IsNumeric(ID6) Then
Where2 = Where1 & ID2 & "." & ID3 & "." & ID4 & "." & ID5 & "." & ID6
RowFound = 5
RowUp2 = WorksheetFunction.CountA(Workbooks(Fiii).Worksheets(1).Range(Coll & X1).Offset(RowFound).EntireRow)
End If
End If
End If
End If
Workbooks(Fiii).Worksheets(1).Range(Coll & X1).Value = Where2
For J = 1 To RowUp2
Workbooks(Fiii).Worksheets(1).Range(Coll & X1).Offset(, J).Value = Workbooks(Fiii).Worksheets(1).Range("A" & X1).Offset(RowFound, J).Value
Next J
' Kill rows below
Application.ScreenUpdating = False
Workbooks(Fiii).Activate
Workbooks(Fiii).Worksheets(1).Range(Range("A" & X1).Offset(1), Range("A" & X1).Offset(RowFound)).EntireRow.Delete
ThisWorkbook.Activate
Application.ScreenUpdating = True
X1 = X1 - RowFound
Max1 = Workbooks(Fiii).Worksheets(1).Range("A1").CurrentRegion.Rows.Count
End If
NextC:
Next
NextX1:
X1 = X1 + 1
Loop Until X1 >= Max1
Application.Calculation = xlCalculationAutomatic
End Sub

ForFile, Optional Colo
ForFile is the ID of Settings found in 'Settings' sheet to read workbook name from, see [Pre-Requirements]

Views 3,462

Downloads 1,361

CodeID
DB ID