Loop through column by column name

user_13349937 0
Viewed 181

I would like to make every string in a column lowercase and remove all spaces. But I would like to refer to the column name in the code not the column number (because it can vary, I would like to use the code on other sheets where the column has the same name, but is not in same place). The data in the sheet looks as follows (simple example):

furniture color amount
chair Pink 2
sofa pin k 1
table bLue 1
sofa 1

So row 1 is actually the header. I would like to lowercase and remove spaces for the values in column 'color'

I tried

For Each cell In Column('color').cells

        cell.Value = LCase(cell.Value)

    Next cell

Can't even seem to get the loop right

Does anybody have suggestions? Thanks in advance

vba excel
4 Answers

Please, try the next way:

Sub LowerCaseNoSpaces()
  Dim sh As Worksheet, lastR As Long, colName As String, rngProc As Range, necCol As Range
  
  colName = "color"
  Set sh = ActiveSheet

  Set necCol = sh.rows(1).Find(what:=colName, LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=False)
  If Not necCol Is Nothing Then 'if the header has been found:
        Set rngProc = sh.Range(necCol, sh.cells(sh.rows.count, necCol.Column).End(xlUp)) 'set the range from the header to the last filled cell in that column
        'process all the filled column using Evaluate:
        rngProc.value = Application.Evaluate("SUBSTITUTE(LOWER(" & rngProc.Address & "), "" "", """")")
  End If
End Sub
user_22333080

Lower and Replace in Column Range

Option Explicit

Sub LowerAndReplaceInColumnRangeTEST()
    
    Const Header As String = "Color"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
    
    LowerAndReplaceInColumnRange ws, Header ' , 1, " ", "" ' default values

End Sub

Sub LowerAndReplaceInColumnRange( _
        ByVal ws As Worksheet, _
        ByVal Header As String, _
        Optional ByVal HeaderRow As Long = 1, _
        Optional ByVal SearchString As String = " ", _
        Optional ByVal ReplaceString As String = "")
    Const ProcName As String = "LowerAndReplaceInColumnRange"
    On Error GoTo ClearError
    
    Dim hCol As Variant: hCol = Application.Match(Header, ws.Rows(HeaderRow), 0)
    If IsError(hCol) Then Exit Sub ' header not found
    
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, hCol).End(xlUp).Row
    If lRow <= HeaderRow Then Exit Sub ' no data or just header
    
    Dim rCount As Long: rCount = lRow - HeaderRow
    Dim rg As Range: Set rg = ws.Cells(HeaderRow + 1, hCol).Resize(rCount)
    
    rg.Value = ws.Evaluate("=SUBSTITUTE(LOWER(" & rg.Address _
        & "),""" & SearchString & """,""" & ReplaceString & """)")
    
ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub
user_98140690

Just some quick code, but I think it should work. The GetColumnNumber function takes a name and a range and finds a column with that name in the first row of the range. It returns the column number where it found it. The other code just loops through all rows doing the described replacements and lower casing.

Sub test()
   Dim myrange As Range
   
   Set myrange = Application.ActiveSheet.usedrange
   
   colorcolumn = GetColumnNumber("color", myrange)
   For x = 2 To myrange.Rows.Count
      currdata = myrange.Cells(x, colorcolumn)
      myrange.Cells(x, colorcolumn) = Replace(LCase(currdata), " ", "")
    Next x
   
End Sub

Function GetColumnNumber(n As String, r As Range)
    For x = 1 To r.Columns.Count
        If r.Cells(1, x) = n Then
            GetColumnNumber = x
            Exit For
        End If
    Next x
End Function
user_55965800

Assuming you want to replace all spaces and not just trim the strings this should work with @BigBen's suggestion of Range.Find and looping through cells

Option Explicit

Public Sub ChangeColumToLower()

    Const HEADER_ROW    As Integer = 1
    Const FIND_COLUMN   As String = "color"
    
    Dim rgeHeader   As Range
    Dim rgeColumn   As Range
    Dim rgeValues   As Range
    
    Dim lngCol      As Long
    Dim lngRow      As Long
    Dim lngLastRow  As Long
    
    Dim colValue    As Object
    
    Set rgeHeader = Range(HEADER_ROW & ":" & HEADER_ROW) ' Header Row
    Set rgeColumn = rgeHeader.Find(FIND_COLUMN)
    lngCol = rgeColumn.Column
    lngRow = rgeColumn.Row + 1
    
    ' Best way to find last row of data if column has empty cells
    lngLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row 
    
    Set rgeValues = Range(Cells(lngRow, lngCol), Cells(lngLastRow, lngCol))
    
    ' Loop through all values
    For Each colValue In rgeValues
        ' Change to lower case and remove all spaces
        colValue.Value = Replace(LCase(colValue.Value), " ", vbNullString)
    Next
        
End Sub
user_24191280
Related