Removing leading line breaks in all the cells

[xlsmnewb]

Hi guys,

I am looking for a solution that allows me to remove all leading line breaks in all the cells and I have came across the following chunk of codes.

===== code =====
Sub TrimEmptyLines()
Dim cel As Range, s As String, len1 As Long, len2 As Long
For Each cel In ActiveSheet.UsedRange
If Not IsError(cel.Value2) Then
If InStr(1, cel.text, vbLf) > 0 Then
s = Trim(cel.Value2)
Do ' remove duplicate vbLf
len1 = Len(s)
s = Replace$(s, vbLf & vbLf, vbLf)
len2 = Len(s)
Loop Until len2 = len1

' remove vblf at beginning or at end
If Left$(s, 1) = vbLf Then s = Right$(s, Len(s) - 1)
If Right$(s, 1) = vbLf Then s = Left$(s, Len(s) - 1)

cel.value = Trim$(s)
End If
End If
Next
End Sub
===== code =====

However, this code will only work if I manually double-click into the cell before I run the macro. Is there sth wrong with the code or is there something wrong with my excel. Would appreciate any assistance. Thank you.

 

[rollis13]

No way, tested your macro, it correctly does it's job. Your issue has to be searched elsewere.
Do you have other macros in your project ? what sort of macros ?

 

[xlsmnewb]

No way, tested your macro, it correctly does it's job. Your issue has to be searched elsewere.
Do you have other macros in your project ? what sort of macros ?

Yes, I do have other macros that extract data from different worksheets and paste the data into a single sheet. Once the extraction is done, I tried running the above macro separately. However, when I run the above code, it can't remove the leading line breaks unless I manually double-click into the cell. You may refer to the code below but it might be messy. Really appreciate your help.

===== code =====
Public Sub ExtractFindings()

'==========================================================================================
'Description
'==========================================================================================
'- this macro conduct HCR
'- this macro stores data from sheet '1' into array
'- then loop through all columns in each row
'- note:
' > ensure that the keyword in '1' is exact as those in the GPRs since the find function is searching for exact value
' > if missing anything character/symbol, it will be identified as no value found

'==========================================================================================
'Configuration
'==========================================================================================
'if set to True, coordinates of value will be printed so that you can verify if it's getting values from the correct cell
cellCoordinates = False

'==========================================================================================
'Code
'==========================================================================================
'declaring mainWBk
Dim mainWBk As Workbook
'set the workbook with the code as the book we will be working on
Set mainWBk = ThisWorkbook
'store everything from sheet '1' and '2' into array
arr1 = ThisWorkbook.Worksheets("1").Range("A1").CurrentRegion
arr2 = ThisWorkbook.Worksheets("2").Range("A1").CurrentRegion
'arraylist to store findings
Set arrList = CreateObject("System.Collections.ArrayList")
' get sheet number of '2'
a1 = mainWBk.Sheets("2").Index

'prevent screen from flickering
Application.ScreenUpdating = False

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Main segment
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'loop rows of array
For i = 2 To UBound(arr1, 1)
'loop imported GPRs
For j = a1 + 1 To mainWBk.Sheets.Count

'clear a2 for the next search
a2 = ""
'clear arrList for the next search
arrList.Clear

mainWBk.Sheets(j).Activate
'here so that when looping column, it wont start with 'A1' again
Range("A1").Select

'loop columns of array
For k = 4 To UBound(arr1, 2)
'current keyword to be searched
a3 = arr1(i, k)

'if column in '1' is ""/Remarks/Remark, skip column
If a3 <> "" And arr1(1, k) <> "Remarks" And arr1(1, k) <> "Remark" Then
'XlLookAt enumeration (Excel)
Set r = Range("A:Z").Find(What:=a3, After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)

If Not r Is Nothing Then
r.Select
'VBA - Add Items to Array
'ArrayList remove duplicates (make unique)?
If cellCoordinates = True Then
If r.Offset(0, 1) <> "" Then
cellAddr = r.Offset(0, 1).Address
cellVal = r.Offset(0, 1).Value
cellCell = "(" & cellAddr & ") " & cellVal
arrList.Add cellCell
End If

If arrList.contains("Data not found.") = True Then arrList.Remove "Data not found."
Else
arrList.Add r.Offset(0, 1).Value

If arrList.contains("Data not found.") = True Then arrList.Remove "Data not found."
End If
Else
'Check if arraylist is empty
If arrList.Count = 0 Then arrList.Add "Data not found."
End If
End If
Next k

For m = 0 To arrList.Count - 1
a2 = a2 & vbCrLf & arrList(m)
Next m

'paste into review sheet
mainWBk.Sheets("2").Activate
'Dim r1, r2 As Range
'Dim rowRow, colCol As Integer
'get current finding name
a4 = arr1(i, 1)
'get name of the device being reviewed
a5 = mainWBk.Sheets(j).Name
'find sheet for finding name
Set r1 = Range("A:ABC").Find(What:=a4, After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
'find sheet for device name
Set r2 = Range("A:ABC").Find(What:=a5, After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
'get row of finding name
rowRow = r1.Row
'get column of device name
colCol = r2.Column
'store value into row and column retrieved
Cells(rowRow, colCol).Value = a2
'Cells(i, j - 1).Value = a2
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'remove extra line breaks from the front in each cell
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Next j
Next i
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Main segment
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'clean and format imported GPRs
cleanSheetFunc = CleanSheet()

'prevent screen from flickering
Application.ScreenUpdating = True

'save workbook
ActiveWorkbook.Save

End Sub
===== code =====

 

[rollis13]

Can't see anything in this other macro that could cause the issue you state.
By the way, what is this line for ? what does it do ? cleanSheetFunc = CleanSheet()
Have you tried to Debug your macros ? do they run smoothly. What happen during Debug if you don't double-click a cell. What sheet has the focus ?

 

[xlsmnewb]

Can't see anything in this other macro that could cause the issue you state.
By the way, what is this line for ? what does it do ? cleanSheetFunc = CleanSheet()
Have you tried to Debug your macros ? do they run smoothly. What happen during Debug if you don't double-click a cell. What sheet has the focus ?

Ooh that cleanSheetFunction formats the worksheet such as removing colours and setting the same font throughout.
And yep everything runs smoothly with no errors. Those I didn't double click into the cell, are not affected by the 'remove leading line break' macro.
Anyway, I have resolved the issue using another method. Since the values are stored in an array list, I just made it so empty cells will not be stored in the array list.
Thank you for your help

 

[rollis13]

Ok, but what does removing leading line breaks (your request) do with empty cells will not be stored (your solution)? Empty cells don't have leading line breaks, elsewise, they wouldn't be empty.