Solved

How to Autofill Across to next value

Posted on 2016-10-17
4
53 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

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

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

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

786 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