Solved

How to Autofill Across to next value

Posted on 2016-10-17
4
44 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
ID: 41847304
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
ID: 41848595
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
ID: 41849325
This solution worked for what I was trying to accomplish.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 41875840
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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.
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

929 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

15 Experts available now in Live!

Get 1:1 Help Now