?
Solved

How to Autofill Across to next value

Posted on 2016-10-17
4
Medium Priority
?
88 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 27

Accepted Solution

by:
Glenn Ray earned 2000 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 46

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 46

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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

762 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