Is it possible to fill cells in a range with "x" if the number of filled cells in that column can't be divided by 4 using VBA?

Return a Column in a String Conditionally

• Adjust the values in the constants section.
• Reference the worksheet more safely.

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Tests the 'StrFilledColumnRange' function.
' Calls:        StrFilledColumnRange, TextString.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub StrFilledColumnRangeTEST()
    
    ' Define constants.
    Const FilePath As String = "C:\Test\Test.txt"
    Const crgAddress As String = "C8:C104"
    Const FillString As String = "x"
    Const ModNonBlank As Long = 4
    Const HasHeader As Boolean = True

    ' Reference the worksheet ('ws').
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Reference the (one-column) range ('crg').
    Dim crg As Range: Set crg = ws.Range(crgAddress)
    
    ' Using the function, return the required values in a string ('rString').
    Dim rString As String
    rString = StrFilledColumnRange(crg, FillString, ModNonBlank, True)
    
    ' Check if the string is empty.
    If Len(rString) = 0 Then
        MsgBox "The resulting string is empty.", vbExclamation
        Exit Sub
    End If

    ' Display the result.
    Debug.Print rString
    'MsgBox rString, vbInformation

    ' Write the string to a text file.
    'TextString FilePath, rString

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      From a given one-column range, returns a string that...
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function StrFilledColumnRange( _
    ByVal ColumnRange As Range, _
    ByVal FillString As String, _
    Optional ByVal ModNonBlank As Long = 1, _
    Optional ByVal HasHeader As Boolean = False) _
As String
    Const ProcName As String = "StrFilledColumnRange"
    On Error GoTo ClearError
    
    ' Reference the first cell ('fCell') of the range.
    Dim fCell As Range: Set fCell = ColumnRange.Cells(1)
    
    ' Reference the column data range ('cdrg')(no headers).
    Dim hrOffset As Long
    If HasHeader Then hrOffset = 1
    Dim cdrg As Range: Set cdrg = ColumnRange _
        .Resize(ColumnRange.Rows.Count - hrOffset).Offset(hrOffset)
    
    ' Make sure that all rows and columns are visible, or the following
    ' use of the Find method will fail.
    ' Reference the bottom-most non-blank cell ('lCell')
    ' of the column data range ('xlValues' - non-blanks).
    Dim lCell As Range: Set lCell = cdrg.Find("*", , xlValues, , , xlPrevious)
    If lCell Is Nothing Then
        MsgBox "No data in '" & cdrg.Address(0, 0) & "'.", vbCritical
        Exit Function
    End If
    
    ' Retrieve the current number of rows ('crCount') of the column data range.
    Dim crCount As Long: crCount = lCell.Row - fCell.Row - hrOffset + 1
    
    ' Calculate the remainder ('Remainder'), the number of how many
    ' fill strings to be 'appended'.
    Dim Remainder As Long: Remainder = crCount Mod ModNonBlank
    If Remainder > 0 Then Remainder = ModNonBlank - Remainder
    
    ' Write the source number of rows to a variable ('srCount').
    Dim srCount As Long: srCount = ColumnRange.Rows.Count
    
    ' Calculate the destination number of rows ('drCount')
    ' and correct 'Remainder'.
    Dim drCount As Long: drCount = hrOffset + crCount + Remainder
    If drCount > srCount Then
        Remainder = Remainder + srCount - drCount
        drCount = srCount
    End If
    
    ' Declare a variable for the resulting string ('rString').
    Dim rString As String
    
    If drCount = 1 Then ' one cell only; unlikely yet theoretically possible
        rString = ColumnRange.Value
    Else ' multiple cells
        ' Reference the last (offsetted) cell.
        Set lCell = lCell.Offset(Remainder)
        ' Reference the range ('crg').
        Dim crg As Range: Set crg = ColumnRange.Worksheet.Range(fCell, lCell)
        ' Write the values from the range to a 2D one-based array ('cData').
        Dim cData() As Variant: cData = crg.Value
        ' Write the fill string(s) to the array.
        Dim dr As Long ' Current Destination Row
        For dr = drCount To drCount - Remainder + 1 Step -1
            cData(dr, 1) = FillString
        Next dr
        ' Write the values from the array to the resulting string.
        rString = cData(1, 1)
        For dr = 2 To drCount
            rString = rString & vbLf & cData(dr, 1)
        Next dr
    End If
    
    ' Return the string as the result of the function.
    StrFilledColumnRange = rString
    
ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Writes a string to a file.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub TextString( _
        ByVal FilePath As String, _
        ByVal WriteString As String)
    Const ProcName As String = "TextString"
    On Error GoTo ClearError
    
    Dim TextFile As Long: TextFile = FreeFile
    
    Open FilePath For Output Access Write As #TextFile
        Print #TextFile, WriteString
    Close TextFile
    
ProcExit:
    Exit Sub
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Sub

The following will pad the cells with x until there are a multiple of 4 cells populated:

Sub pad_to_mod_4()

    Dim myrange As Range
    Dim ws As Worksheet

    padding = "x"
    
    Set ws = ActiveSheet                'set this to your worksheet
    Set myrange = ws.Range("C8:C104")
    
    Do Until myrange.Cells.SpecialCells(xlCellTypeConstants).Count Mod 4 = 0
        myrange(myrange.Count).End(xlUp).Offset(1, 0).Value = padding
    Loop
    
End Sub