Auto fill downwards until row value change

**dmjogeman** · 09-03-2009, 05:46 AM

Thanks for any help with this.

**blackworx** · 09-03-2009, 07:39 AM

Select the area, columns, or a single cell within the table you want to fill, then run this macro:

Sub GapFill()

    Dim r As Range, c As Range
    
    Set r = Selection
    
    If Not r Is Nothing Then
    
        If r.Address = r.EntireColumn.Address Then
        
            With r.Parent
            
                Set r = Range(.Cells(1, r.Column), .Cells(.Cells(1, r.Column).CurrentRegion.Rows.Count, r.Column + r.Columns.Count - 1))
            
            End With
        
        ElseIf r.Cells.Count = 1 Then
            
            Set r = r.Parent.Cells(r.Row, r.Column).CurrentRegion
            
        End If
        
    
        For Each c In r.Cells
        
            If IsEmpty(c) Then c = r.Parent.Cells(c.Row - 1, c.Column)
        
        Next c
        
    End If
    
End Sub

**dmjogeman** · 09-03-2009, 09:23 AM

WONDERFUL! Darn, that works like a clock!

Many, many THANKS blackworx! u made my day

Best regards
David

**blackworx** · 09-03-2009, 09:52 AM

No worries

- and thank you for asking. I've been meaning to write something to automate this exact thing for a while, but never got round to it.

Since posting I've made it a little more robust:

Sub GapFill()

    Dim r As Range, c As Range
    
    On Error Resume Next
    
    Set r = Selection
    
    If Not Err.Number Then
    
        On Error GoTo 0
    
        If Not r Is Nothing And r.Areas.Count = 1 Then
        
            If r.Address = r.EntireColumn.Address Then
            
                With r.Parent
                
                    Set r = Range(.Cells(1, r.Column), .Cells(.Cells(1, r.Column).CurrentRegion.Rows.Count, r.Column + r.Columns.Count - 1))
                
                End With
            
            ElseIf r.Cells.Count = 1 Then
                
                Set r = r.CurrentRegion
                
            End If
            
        
            For Each c In r.Cells
            
                If IsEmpty(c) and c.Row > 1 Then c = r.Parent.Cells(c.Row - 1, c.Column)
            
            Next c
            
        Else
    
            MsgBox "Invalid selection", vbExclamation, "GapFill"
                
        End If
        
    Else
    
        MsgBox "Invalid selection", vbExclamation, "GapFill"
            
    End If

End Sub

if you run the macro on an entire column or several columns, then only the rows which fall in the first contiguous area covered by the selection will be filled. Hope that makes sense. if not, don't worry about it - it probably won't make any difference.

**Mmhgators** · 05-12-2011, 03:15 PM

Hello,

I know this EXTREMELY helpful tip was posted in 2009, but just in case you receive Email notification when anyone responds to your post, I just wanted to let you know I have literally been searching online for three hours on how to fill multiple ranges with different values in one column. Your post was so very helpful to me, I am working on a 3,600 company profile list of which many of the companies, addresses and zip codes are listed several times. Would have taken me months, I appreciate the assistance!

Marcella

**blackworx** · 05-24-2011, 04:01 AM

Hi Marcella, yes I had left notifications on so thanks for letting me know - glad to help!

I'm always surprised at how many people in my office find this particular wee macro helpful.