Loop event - apply cell or row formatting based on the leading space value in a cell-CodePudding

Column A contains a large list of text values where there are leading spaces. Based on the space value, I want to apply formatting to the cell or the row for the range. For the selection, I found a way to find the indent level; cell.offset(0,-1).value=cell.IndentLevel.

How can I find the leading space count using this approach? Would .value become .formula? There are methods to find the space count as a formula in a cell which includes =Find(Left(Trim(A1),1),A1)-1, however formulating this in vba is a bit tricky for me.

Perhaps there is a way to apply .value=cell.xx to find the leading space value so I can apply the format as required? Any suggestions? Tx!

CodePudding user response：

If you wanted to use the formula as you've got above, you could do it a number of ways but to demonstrate a decoupled from the cell version, you would do it like this ...

Public Sub GetSpacesUsingFindFunctionInVBA()
    Dim strText As String, intSpaceCount As Integer
    
    strText = "    Four spaces"
    
    intSpaceCount = WorksheetFunction.Find(Left(Trim(strText), 1), strText) - 1
    
    Debug.Print intSpaceCount
End Sub

This will also work ...

intSpaceCount = InStr(1, strText, Trim(strText)) - 1

There should be enough there for you to adapt to your requirement within your loop.

CodePudding user response：

Count Leading Spaces

The Function

Option Explicit

Function LeadingSpacesCount( _
    ByVal SearchString As String, _
    Optional ByVal ExcludeSpacesOnly As Boolean = False) _
As Long
    Dim slen As Long: slen = Len(SearchString)
    If slen = 0 Then Exit Function
    Dim ltLen As Long: ltLen = Len(LTrim(SearchString))
    Dim lsLen As Long: lsLen = slen - ltLen
    If ExcludeSpacesOnly Then
        If lsLen = slen Then Exit Function
    End If
    LeadingSpacesCount = lsLen
End Function

Usage Excel

= LeadingSpacesCount(A2)

or, to exclude cells containing only spaces:

= LeadingSpacesCount(A2,TRUE)

Usage VBA

Adjust the values in the constants section and improve the worksheet reference.

Sub WriteSpacesCount()
    
    Const sCol As String = "A" ' Source
    Const dCol As String = "G" ' Destination
    Const fRow As Long = 2 ' e.g. first row is headers
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, sCol).End(xlUp).Row
    If lRow < fRow Then Exit Sub ' no data
    
    Dim rg As Range: Set rg = ws.Cells(fRow, sCol).Resize(lRow - fRow   1)
    
    Dim Data As Variant
    If rg.Rows.Count = 1 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
    Else
        Data = rg.Value
    End If
    
    Dim r As Long
    
    For r = 1 To UBound(Data, 1)
        Data(r, 1) = LeadingSpacesCount(CStr(Data(r, 1)))
    Next r
    
    rg.EntireRow.Columns(dCol).Value = Data
    
End Sub

CodePudding user response：

and thanks for responding. My code is a little longer than what was proposed, however below is the code that successfully executes and evaluates the leading space in all rows of column A, and then applies text and cell formatting:

Sub WFP_Proj_Resource()
    Dim i As Long
    Dim sh As Worksheet
    Dim sheetArr As Variant
    Dim CellText As Variant

    Set sh = ThisWorkbook.Sheets("Sheet1")
    sheetArr = sh.UsedRange
    rowC = sh.UsedRange.Rows.Count
    
'Loop through rows in column A, measure the leading space before the text (not indent) and apply format
     For i = 1 To rowC
      CellText = sheetArr(i, 1)
      intSpaceCount = WorksheetFunction.Find(Left(Trim(CellText), 1), CellText) - 1
            If intSpaceCount = "0" Then
                sh.Rows(i).Interior.Color = vbBlue
                sh.Rows(i).Font.Color = vbWhite
                sh.Rows(i).Font.Bold = True
                
             ElseIf intSpaceCount = "1" Then
                sh.Cells(i, 1).Interior.ColorIndex = 37
            
             ElseIf intSpaceCount = "2" Then
                sh.Rows(i).Interior.ColorIndex = 11
                sh.Rows(i).Font.Color = vbWhite
                sh.Rows(i).Font.Bold = True
                
            ElseIf intSpaceCount = "3" Then
                sh.Cells(i, 1).Interior.ColorIndex = 12
         End If
    Next i   
End Sub