Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

How to Autofill Across to next value

Posted on 2016-10-17
4
Medium Priority
?
95 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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

609 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