Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macro to fill in missing gaps

Status
Not open for further replies.

Brianfree

Programmer
Feb 6, 2008
220
0
0
GB
Hi, I have some data that has missing values, please can anyone assist on writing a macro to fill in the gaps?

Please see example..

Code:
What I currently have...

COL1, COL2
aaa, 100
bbb
ccc
ddd
eee, 50
fff
ggg, 30
hhh, 22
iii
jjj, 400
kkk
lll
mmm
nnn
ooo
ppp
qqq
rrr
sss
ttt
uuu, 10
vvv

Code:
What I would like a macro to do...

COL1, COL2
aaa, 100
bbb, 100
ccc, 100
ddd, 100
eee, 50
fff, 50
ggg, 30
hhh, 22
iii, 22
jjj, 400
kkk, 400
lll, 400
mmm, 400
nnn, 400
ooo, 400
ppp, 400
qqq, 400
rrr, 400
sss, 400
ttt, 400
uuu, 10
vvv, 10

Many thanks

Brian
 
If this is just a one-off fix, I'd use a formula instead of a macro. Assuming aaa is in cell A2, enter =IF(B2="",C1,B2) into C2, then copy C2 into the rest of column C. If column B contains a value, it will use that. Otherwise it will pick up the value from the cell above it.

ColA, ColB, Formula in ColC
aaa, 100, =IF(B2="",C1,B2)
 
Here is a macro that will fill down with values from the cells above. It does so using a formula with R1C1 addressing.

As written, the macro uses a selected range of cells. I've commented out a few optional ways of setting the range. I also commented out a statement that replaces the formulas with the values returned.
Code:
Sub Infill()
'Copies the value from the row above into blank cells.
On Error Resume Next
With Selection       'Run code on pre-selected range of cells
'With Range(ActiveCell, Cells(65536, ActiveCell.Column).End(xlUp))   'Start with active cell, and continue through bottom of data
'With Intersect(ActiveCell.EntireColumn, ActiveCell.CurrentRegion)  'Different way of setting range which works better in some cases
    '.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"     'Blank cells set equal to value from row above
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C+1"     'Blank cells set equal to value from row above plus 1 day
    '.Formula = .Value   'Optional:  Replace the formulas with the values returned by the formulas
End With
On Error GoTo 0
End Sub
Brad
 
Or you can do this:

Code:
Dim intX As String
Dim intRow As Integer

intRow = 2 [green]'data starts in row 2[/green]

Do While Range("A" & intRow).Value <> ""
    If Range("B" & intRow).Value <> "" Then
        intX = Range("B" & intRow).Value
    Else
        Range("B" & intRow).Value = intX
    End If
    intRow = intRow + 1
Loop

Have fun.

---- Andy
 
Ooops

The line: [tt]Dim intX As String[/tt]
should be: [tt] Dim intX As Integer [/tt]

but it wil work either way :)

Have fun.

---- Andy
 
Code:
Sub test()
    Dim r As Range
    
    For Each r In Range(Cells(1, 1), Cells(1, 1).End(xlDown))
        With r.Offset(0, 1)
            If .Value = "" Then
                .Value = .Offset(-1).Value
            End If
        End With
    Next
End Sub

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
I copied the code from another thread, and should have deleted one of the lines. My apologies for the screw-up.

For your specified layout, you may want to consider using the third With alternative. The code will then rely on the extent of data in other columns to determine how much to fill down. If you choose this approach, select any cell in the column that needs to be filled down, then run the macro.
Code:
Sub Infill()
'Copies the value from the row above into blank cells.
On Error Resume Next
'With Selection       'Run code on pre-selected range of cells
'With Range(ActiveCell, Cells(65536, ActiveCell.Column).End(xlUp))   'Start with active cell, and continue through bottom of data
With Intersect(ActiveCell.EntireColumn, ActiveCell.CurrentRegion)  'Different way of setting range which works better in some cases
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"     'Blank cells set equal to value from row above
    '.Formula = .Value   'Optional:  Replace the formulas with the values returned by the formulas
End With
On Error GoTo 0
End Sub
 
Hi,

Highlight COL2 aaa to vvv, [Ctrl]+[G], [Alt]+, [Alt]+[K], Only Blank Cells are selected, type =B2 or cell above active Cell and press [Ctrl]+[ENTER]

Yuri
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top