Get values from available column in a row to the first column of the same row

Need help to achieve the below requirement

I need to search column C to I for each row whenever a value found it will copy to C column of that row.

Before:

After:

Sub FindCelValandFill()
    Dim rng As Range
    Dim lastRow As Long
    Dim cell As Range

    lastRow = Cells(Rows.Count, "B").End(xlUp).Row
    Set rng = Range("C2:I2" & lastRow)
    For Each cell In rng
        If cell.Value = "" Then
            cell.Value = cell.Offset(0, 1).Value
        End If
    Next cell
End Sub

Result of

Sub FindCelValandFill()
Dim rng As Range
Dim lastRow As Long
Dim cell As Range

lastRow = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("C2:I2" & lastRow)
For Each cell In rng
    If cell.Value = "" Then
        cell.Value = cell.Parent.Evaluate("=CONCAT(" & cell.Resize(1, 50).Address & ")")
    End If
Next cell

End Sub

enter image description here

From Multiple to Single Column

• This will return the concatenated values of each row in the first column.

Sub FillColumnOne()

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Dim rg As Range: Set rg = ws.Range("C2:I" & LastRow)
   
    Dim rrg As Range
    
    For Each rrg In rg.Rows
        rrg.Cells(1).Value = Evaluate("=CONCAT(" & rrg.Address & ")")
    Next rrg

    rg.Resize(, rg.Columns.Count - 1).Offset(, 1).ClearContents
    
End Sub

• This will return the left-most (non-blank) value of each row in the first column.

Sub FillColumnLeft()

    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Dim rg As Range: Set rg = ws.Range("C2:I" & LastRow)
   
    Dim rrg As Range, cell As Range
    
    For Each rrg In rg.Rows
        For Each cell In rrg.Cells
            If Len(CStr(cell.Value)) > 0 Then
                rrg.Cells(1).Value = cell. Value
                Exit For
            End If
        Next cell
    Next rrg

    rg.Resize(, rg.Columns.Count - 1).Offset(, 1).ClearContents
    
End Sub

EDIT

Introducing Efficiency and Flexibility

• This is an improvement over the 2nd solution.

Main

Sub FillFirstColumn()

    ' Define constants.
    Const FIRST_COLUMN As Long = 3
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Reference the range.
    Dim ColumnDifference As Long: ColumnDifference = FIRST_COLUMN - 1
    ' When you have nice contiguous data (no empty rows or columns),
    ' you can utilize 'CurrentRegion' to reference the whole range.
    ' Then use 'Resize' and 'Offset' to reference the required columns.
    Dim rg As Range:
    With ws.Range("A1").CurrentRegion ' referencing the whole table range
        ' Check if the range has too few rows.
        If .Rows.Count = 1 Then ' only headers or nothing
            MsgBox "There is only one row in the range ""'" _
                & ws.Name & "'!" & .Address(0, 0) & """!", vbExclamation
            Exit Sub
        End If
        ' Check if the range has too few columns.
        Select Case .Columns.Count - ColumnDifference
            Case 1: Exit Sub ' one column to process i.e. already written
            Case Is < 1:
                MsgBox "The first column is set to " & FIRST_COLUMN & "." _
                    & vbLf & "There are too few columns in the range ""'" _
                    & ws.Name & "'!" & .Address(0, 0) & """!", vbExclamation
                Exit Sub
        End Select
        ' Reference the required range, the range without the header row
        ' and the columns before the first column (at least 2 columns).
        Set rg = .Resize(.Rows.Count - 1, _
            .Columns.Count - ColumnDifference).Offset(1, ColumnDifference)
    End With
    
    ' Return the values of the range in a 2D one-based array.
    ' Reading the values from the array instead of the range (worksheet)
    ' is much faster.
    Dim Data() As Variant: Data = rg.Value
   
    ' Use the helper sub to move the left-most values to the first column.
    MoveLeftValuesToFirstColumn Data
   
    ' Return the values of the first column of the array
    ' in the first column of the range. Copying values in one go
    ' is much faster then doing it many times to the range (worksheet).
    rg.Columns(1).Value = Data
        
    ' Clear the values in all but the first column of the range.
    rg.Resize(, rg.Columns.Count - 1).Offset(, 1).ClearContents
        
End Sub

Help

Sub MoveLeftValuesToFirstColumn(ByRef Data() As Variant)
    Dim ColumnsCount As Long: ColumnsCount = UBound(Data, 2)
    Dim r As Long, c As Long, IsNotFirstColumn As Boolean
    For r = 1 To UBound(Data, 1) ' rows
        IsNotFirstColumn = False ' reset for each row
        For c = 1 To ColumnsCount ' columns
            If Len(CStr(Data(r, c))) > 0 Then
                ' No need to write if it's already written in the first column.
                If IsNotFirstColumn Then Data(r, 1) = Data(r, c)
                Exit For
            Else
                IsNotFirstColumn = True
            End If
        Next c
    Next r
End Sub