Solved

How to Autofill Across to next value

Posted on 2016-10-17
4
35 Views
Last Modified: 2016-11-05
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
0
Comment
Question by:MATO0618
  • 2
4 Comments
 
LVL 27

Accepted Solution

by:
Glenn Ray earned 500 total points
Comment Utility
This code will extend your headers across to the last-used column (that is, the last column with any data):
Option Explicit
Sub Extend_Headers()
    Dim strRow1, strRow2, strRow3 As String
    Dim intLastColumn As Integer
    
    intLastColumn = Cells.SpecialCells(xlCellTypeLastCell).Column
    Range("D3").Select
    Do Until ActiveCell.Column > intLastColumn
        If ActiveCell.Value <> "" Then
            strRow1 = ActiveCell.Value
        Else
            ActiveCell.Value = strRow1
        End If
        If ActiveCell.Offset(1, 0).Value <> "" Then
            strRow2 = ActiveCell.Offset(1, 0).Value
        Else
            ActiveCell.Offset(1, 0).Value = strRow2
        End If
        If ActiveCell.Offset(2, 0).Value <> "" Then
            strRow3 = ActiveCell.Offset(2, 0).Value
        Else
            ActiveCell.Offset(2, 0).Value = strRow3
        End If
        ActiveCell.Offset(0, 1).Select
    Loop
End Sub

Open in new window


This raises a question:  How do you/we know how far to the right to extend the headers?  In your example set, there there are three columns for "Product 2" under "USA", but the header only shows one implied column for "Product 2" for "Canada".  How do I know you don't need two more columns?  or three?  or twenty? :-)

See the attached macro-enabled workbook.

-Glenn
EE-C-Users-SZYYNR-Documents-Mattie-.xlsm
0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
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

0
 

Author Closing Comment

by:MATO0618
Comment Utility
This solution worked for what I was trying to accomplish.
0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
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

0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now