asked on

How to Autofill Across to next value

I'd like to auto fill blank cells from cell value with data to next cell with value, then repeat for each value using VBA,

See attached.

This is my original data

                  USA                                CAN
                  Product 1               Product 2                    Product 1             Product 2
                  2017                                2017

This is the results that I'd like to see

USA        USA        USA        USA        USA       CAN        CAN       CAN
                  Product 1      Product 1      Product 2      Product 2      Product 2      Product 1      Product 1      Product 2
                  2017        2017        2017        2017        2017        2017        2017        2017
C--Users-SZYYNR-Documents-Mattie-Au.xlsx

ASKER CERTIFIED SOLUTION

Glenn Ray

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

aikimark

This code requires you to select the cells you want filled right (non-overwrite)

Sub Q_28976936()
    Dim rng As Range
    Dim rngEnd As Range
    Dim rngRow As Range
    Dim wks As Worksheet
    Dim lngCol As Long
    
    'ToDo: Validate selection?
    
    Set wks = ActiveSheet
    For Each rngRow In Selection.Rows
        Set rng = rngRow.Cells(1, 1)
        Set rngEnd = rng.End(xlToRight).Offset(0, -1)
        Do While True
            If rngEnd.Column > Selection.Cells(1, Selection.Columns.Count).Column Then
                Set rngEnd = wks.Cells(rngRow.Row, Selection.Cells(1, Selection.Columns.Count).Column)
                If rng.Column < rngEnd.Column Then
                    wks.Range(rng, rngEnd).FillRight
                End If
                Exit Do
            Else
                wks.Range(rng, rngEnd).FillRight
                Set rng = rng.End(xlToRight)
                Set rngEnd = rng.End(xlToRight).Offset(0, -1)
            End If
            
        Loop
    Next
    
End Sub

Open in new window

Mattie Owens

ASKER

This solution worked for what I was trying to accomplish.

aikimark

I was playing around with some of the specialcells collections when I realized that this problem could be solved using one of those cell sets. I'm posting here (post closure) for future readers.

Sub Q_28976936()
    Dim colBuckets() As New Collection
    Dim rng As Range
    Dim rngBlanks As Range
    Dim vItem As Variant
    Dim lngLoop As Long
    
    ReDim colBuckets(Selection.Cells(1, 1).Column To Selection.Cells(1, Selection.Columns.Count).Column)
    
    Set rngBlanks = Selection.SpecialCells(xlCellTypeBlanks)
    
    For Each rng In rngBlanks.Areas
        colBuckets(rng.Cells(1, 1).Column).Add rng
    Next
    
    For lngLoop = LBound(colBuckets) To UBound(colBuckets)
        For Each vItem In colBuckets(lngLoop)
            Set rng = vItem
            rng.Worksheet.Range(rng.Offset(0, -1), rng).FillRight
        Next
    Next
End Sub

Open in new window