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? - excel

Question

In a sheet of my workbook I have range C8:C104 filled with values from another sheet of my workbook. These number of values can vary from 2 to 96 with no blank cells in between.
Before copying these values to a txt-file I need to auto fill blank cells in this column until the number of non blank cells in the range can be divided by 4.
Example:
C8:C12 contain data => no cells need to be auto filled
C8:C10 contain data => Cells C11 and C12 need to be filled with the text "x" (the rest of the cells in the range stay blank)
Normally Google is my best friend in situations like this, but unfortunately I could not find any Q&A similar to this. I got the part running to copy the cells and sending them as a txt.file by outlook mail, but have no clue how to get the auto fill part up and running yet.
Is there anyone who can help me get started, am not very experienced and a bit rusty with my VBA skills?

Answer 1

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

Answer 2

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