Filling multiple columns witha loop

[Brucea]

I have the following code to fill in cell in column B. It works fine but I have a 4 other columns (Columns C,G,H,N) where I need to fill in the same information (whatever the contents of the first cell in that column is). There must be a more efficient way to fill than to copy the code 4 times. The columns will not change.

Public Sub CountColorBlanks()
Dim CurrentCell As String, StyleRowsCount As Integer, ColorRowsCount As Integer
Dim TotalRows As Integer, StyleName As String
Sheets("Raw Data").Select
Range("B1").Select
' initialize Variables
StyleName = ActiveCell.Value
CurrentCell = ActiveCell.Value
' Get the total Number of rows
StyleRowsCount = Range("C" & Rows.Count).End(xlUp).Row
ColorRowsCount = Range("AA" & Rows.Count).End(xlUp).Row
If StyleRowsCount > ColorRowsCount Then
TotalRows = StyleRowsCount
Else
TotalRows = ColorRowsCount
End If
' Check if we are at the end of the list
Do Until TotalRows = ActiveCell.Row
'blank rows get the PRODUCT TYPE name filled in, when the style name changes the loopstarts over
If CurrentCell = "" Then
ActiveCell.Value = StyleName
Selection.Offset(1).Select 'moves to next cell down
CurrentCell = Selection.Value
Else
StyleName = ActiveCell.Value
Selection.Offset(1).Select 'moves to next cell down
CurrentCell = Selection.Value
End If

Loop
End Sub

 

[CharlesH]

Hi,

I added an array to your code.
This should(not tested) loop thru each column that you specified.
There is 1 line of you code I'm not sure it it is to be changed I indicated this with <<<<.

Public Sub CountColorBlanks()
Dim MyArray As Variant
Dim CurrentCell As String, StyleRowsCount As Integer, ColorRowsCount As Integer
Dim TotalRows As Integer, StyleName As String
Dim i As Long
MyArray = Array("B", "C", "G", "H", "N")
Sheets("Raw Data").Select
For i = 0 To UBound(MyArray)
    Range(MyArray(i) & "1").Select
' initialize Variables
    StyleName = ActiveCell.Value
    CurrentCell = ActiveCell.Value
' Get the total Number of rows
    StyleRowsCount = Range("C" & Rows.Count).End(xlUp).Row'<< always C??
    ColorRowsCount = Range("AA" & Rows.Count).End(xlUp).Row
    If StyleRowsCount > ColorRowsCount Then
        TotalRows = StyleRowsCount
    Else
        TotalRows = ColorRowsCount
    End If
' Check if we are at the end of the list
    Do Until TotalRows = ActiveCell.Row
'blank rows get the PRODUCT TYPE name filled in, when the style name changes the loopstarts over
        If CurrentCell = "" Then
            ActiveCell.Value = StyleName
            Selection.Offset(1).Select 'moves to next cell down
            CurrentCell = Selection.Value
        Else
            StyleName = ActiveCell.Value
            Selection.Offset(1).Select 'moves to next cell down
            CurrentCell = Selection.Value
        End If

Loop
Next i
End Sub

 

[Brucea]

That seem to be exactly what I am looking for, thanks for your help!