Solved: Fill empty cell with previous value if condition is met

Hi,

I have a range of data that I would like to fill missing gaps for if a condition is met using the last previous available data point in that column and if it doesn't take up too much time, colour the value/font in say red so that I know it is proxy value (or any other colour).

So for example in the attachment, wherever a cell in column A contains Yes, I would like to fill all empty cells in that given row with the previous available value and highlight it in red.

The first yes occurs in row 10, so I want to check for empty rows, columns H and P contain empty cells, I would like to fill these with the previous entries from row 9 and colour the font red.

The next row with a yes containing missing values is row 40. In column E, the previous cell row 39 is also blank however so I want to fill it with the value from row 38 (or last avaliable value).

Below is what I have so far to select the range, hope someone can help with the rest.

Many Thanks,

Skywalker

[VBA]
Sub Macro1()
Dim lastcell, lastcol As Integer
lastcol = Range("B1").End(xlToRight).Column
lastcell = Range("a10000").End(xlUp).Row
Range(Cells(2, 2), Cells(lastcell, lastcol)).Select
End Sub
[/VBA]

Greetings Skywalker,

This is a tad sloppy, but in a test copy of your wb, try:

In a Standard Module:

[vba]
Option Explicit

Sub TackValsFromAbove()
Dim wks As Worksheet
Dim rngInitial As Range
Dim rcell As Range
Dim rngLCol As Range
Dim rngCellInCol As Range
Dim rngCellInRow As Range
Dim rngRow As Range
Dim i As Long
Dim bolFoundAVal As Boolean

Set wks = ThisWorkbook.Worksheets("Sheet1") '<---Change to suit

With wks
Set rngLCol = .Range(.Cells(2, 1), _
.Cells(Rows.Count, Columns.Count)) _
.Find(What:="*", _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
.Columns(1).AutoFilter 1, "Yes"

Set rngInitial = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)

.Range("A:A").AutoFilter


For Each rngCellInCol In rngInitial
Set rngRow = .Range(.Cells(rngCellInCol.Row, "B"), _
.Cells(rngCellInCol.Row, rngLCol.Column))

For Each rngCellInRow In rngRow
If rngCellInRow.Value = vbNullString Then
i = 0
Do
i = i - 1
If Not rngCellInRow.Offset(i).Value = vbNullString Then
With rngCellInRow
.Value = .Offset(i).Value
.Interior.ColorIndex = 3
bolFoundAVal = True
End With
End If
Loop While Not bolFoundAVal
bolFoundAVal = False
End If
Next
Next
End With
End Sub
[/vba]

Question for others: (ie- HELP?!):

What am I not seeing? Why would not:

[vba]
Loop While Not rngCellInRow.Offset(i).Value = vbNullString
[/vba]

kill the looping???

Mark

Hello GTO,

Thanks for the code, I've tested it out and it works as requsted.

Just a couple things thougth in case I need to adapt it in the future.

I'm having problems understanding how it's defining the ranges. For example, does the references here all relate to the lookup condition column A or is it also helping to set other ranges in the sheet?

[VBA]
Set rngLCol = .Range(.Cells(2, 1), _
.Cells(Rows.Count, Columns.Count)) _
.Find(What:="*", _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
.Columns(1).AutoFilter 1, "Yes"

[/VBA]Similary, this section appear to me to be referencing the lookup column A only. Please confirm!

[VBA]
Set rngInitial = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)
.Range("A:A").AutoFilter

[/VBA]
And lastly, I'm assuming this section relates to the range I want to search , i.e from column B to the last column?

[VBA]
For Each rngCellInCol In rngInitial
Set rngRow = .Range(.Cells(rngCellInCol.Row, "B"), _
.Cells(rngCellInCol.Row, rngLCol.Column))
[/VBA]
Thanks,

SW

To minimise the looping
[vba]
.Range("A:A").AutoFilter

For Each rngCellInCol In rngInitial
Set RngRowCells = Intersect(rngCellInCol.Resize(, 24), .Cells.SpecialCells(xlCellTypeBlanks))
If Not RngRowCells Is Nothing Then
For Each Cel In RngRowCells
Cel = Cel.Offset.End(xlUp)
Cel.Interior.ColorIndex = 3
Next
End If
Next
[/vba]

Hi,

I tried intergrating the latest code into the orginal macro but it doesn't seem to work. Also including the line (.Font.ColorIndex = 3) seems to generate an error..

I'm assuming I put this code together incorrectly?

Thanks,

SW


[VBA]
Sub TackValsFromAbove2()
Dim wks As Worksheet
Dim rngInitial As Range
Dim rcell As Range
Dim rngLCol As Range
Dim rngCellInCol As Range
Dim rngCellInRow As Range
Dim rngRow As Range
Dim i As Long
Dim bolFoundAVal As Boolean

Set wks = ThisWorkbook.Worksheets("Sheet1") '<---Change to suit

With wks
Set rngLCol = .Range(.Cells(2, 1), _
.Cells(Rows.Count, Columns.Count)) _
.Find(What:="*", _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
.Columns(1).AutoFilter 1, "Yes"

Set rngInitial = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)

.Range("A:A").AutoFilter

For Each rngCellInCol In rngInitial
Set RngRowCells = Intersect(rngCellInCol.Resize(, 24), .Cells.SpecialCells(xlCellTypeBlanks))
If Not RngRowCells Is Nothing Then
For Each Cel In RngRowCells
Cel = Cel.Offset.End(xlUp)
Sub TackValsFromAbove2()
Dim wks As Worksheet
Dim rngInitial As Range
Dim rcell As Range
Dim rngLCol As Range
Dim rngCellInCol As Range
Dim rngCellInRow As Range
Dim rngRow As Range
Dim i As Long
Dim bolFoundAVal As Boolean

Set wks = ThisWorkbook.Worksheets("Sheet1") '<---Change to suit

With wks
Set rngLCol = .Range(.Cells(2, 1), _
.Cells(Rows.Count, Columns.Count)) _
.Find(What:="*", _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
.Columns(1).AutoFilter 1, "Yes"

Set rngInitial = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)

.Range("A:A").AutoFilter

For Each rngCellInCol In rngInitial
Set RngRowCells = Intersect(rngCellInCol.Resize(, 24), .Cells.SpecialCells(xlCellTypeBlanks))
If Not RngRowCells Is Nothing Then
For Each Cel In RngRowCells
Cel = Cel.Offset.End(xlUp)
' .Font.ColorIndex = 3
Next
End If
Next
End With
End Sub
Next
End If
Next
End With
End Sub

[/VBA]

Sorry, i just noticed that code doesn't look right!

[VBA]
Sub TackValsFromAbove2()
Dim wks As Worksheet
Dim rngInitial As Range
Dim rcell As Range
Dim rngLCol As Range
Dim rngCellInCol As Range
Dim rngCellInRow As Range
Dim rngRow As Range
Dim i As Long
Dim bolFoundAVal As Boolean

Set wks = ThisWorkbook.Worksheets("Sheet1") '<---Change to suit

With wks
Set rngLCol = .Range(.Cells(2, 1), _
.Cells(Rows.Count, Columns.Count)) _
.Find(What:="*", _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
.Columns(1).AutoFilter 1, "Yes"

Set rngInitial = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)

.Range("A:A").AutoFilter

For Each rngCellInCol In rngInitial
Set RngRowCells = Intersect(rngCellInCol.Resize(, 24), .Cells.SpecialCells(xlCellTypeBlanks))
If Not RngRowCells Is Nothing Then
For Each Cel In RngRowCells
Cel = Cel.Offset.End(xlUp)
' .Font.ColorIndex = 3
Next
End If
Next
End With
End Sub

[/VBA]

Give this a try

[VBA]Sub TackValsFromAbove2()
Dim wks As Worksheet
Dim rngInitial As Range
Dim rcell As Range
Dim rngLCol As Range
Dim rngCellInCol As Range
Dim rngCellInRow As Range
Dim RngRowCells As Range
Dim cel As Range
Dim rngRow As Range
Dim i As Long
Dim bolFoundAVal As Boolean

Set wks = ThisWorkbook.Worksheets("Sheet1") '<---Change to suit

With wks
Set rngLCol = .Range(.Cells(2, 1), _
.Cells(Rows.Count, Columns.Count)) _
.Find(What:="*", _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
.Columns(1).AutoFilter 1, "Yes"

Set rngInitial = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)

.Range("A:A").AutoFilter

For Each rngCellInCol In rngInitial
Set RngRowCells = Intersect(rngCellInCol.Resize(, 24), .Cells.SpecialCells(xlCellTypeBlanks))
If Not RngRowCells Is Nothing Then
For Each cel In RngRowCells
cel = cel.Offset.End(xlUp)
cel.Font.ColorIndex = 3
Next
End If
Next
End With
End Sub

[/VBA]

Hi SW,

Late to work and started typing an explanation while about 1/4th awake last night, so not sure if this is clear. If not sensible, don't hesitate to ask again, happy to help.

[vba]
Option Explicit

Sub TackValsFromAbove()
Dim wks As Worksheet
Dim rngInitial As Range
Dim rcell As Range
Dim rngLCol As Range
Dim rngCellInCol As Range
Dim rngCellInRow As Range
Dim rngRow As Range
Dim i As Long
Dim bolFoundAVal As Boolean

Set wks = ThisWorkbook.Worksheets("Sheet1") '<---Change to suit

With wks
'// As we have a header row, rather than depend upon only the "necessary" //
'// columns having a descriptive header, we limit lookimg for a cell w/any //
'// val in it, to cell A2 (the second row) to the last row and column. //
'// This way I think we can reliably find the last colummn w/any data in it,//
'// and use this to later limit how far along ea row we are looking for //
'// blanks. //
'// Please note: I had missed the 'After:=' arg, and I would set this //
'// the last cell/col. //
Set rngLCol = .Range(.Cells(2, 1), _
.Cells(Rows.Count, Columns.Count)) _
.Find(What:="*", _
After:=.Cells(Rows.Count, Columns.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)

'MsgBox rngLCol.Address(False, False)
'// In reference to your second question, I respond in the affirmative, as //
'// to 'rngInitial' only referring to Col A. But... as only the rows w/"Yes"//
'// showing in Col A will be getting checked... //
.Columns(1).AutoFilter 1, "Yes"

'// ...we can set a reference to a non-contiguous range. //
Set rngInitial = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)

'// (Then unhide any "No" rows) //
.Range("A:A").AutoFilter

'// Now, we no longer need to worry about the "yes's" in Col 1, as these //
'// will be the only cells we'll check. //
For Each rngCellInCol In rngInitial
'// Npw we can set a range for each row that had a "Yes" on Col A, //
'// setting said row as from Col B to the last Col we found a val in, //
'// while setting rngLCol. //
Set rngRow = .Range(.Cells(rngCellInCol.Row, "B"), _
.Cells(rngCellInCol.Row, rngLCol.Column))

'// Then, for ea cell in that row/range, we would run up the column... //
For Each rngCellInRow In rngRow
If rngCellInRow.Value = vbNullString Then
i = 0
Do
i = i - 1
'// ...until we find a val; then mark and val the cell... //
If Not rngCellInRow.Offset(i).Value = vbNullString Then
With rngCellInRow
.Value = .Offset(i).Value
.Interior.ColorIndex = 3
bolFoundAVal = True
End With
End If
Loop While Not bolFoundAVal
bolFoundAVal = False
End If
Next
Next
End With
End Sub
[/vba]

I didn't test, but looks like you have Malcom's improvement correctly inserted now.

A great day to all,

Mark

Thanks for fixing mdmackillop and GTO for your detailed, that has really made things easier for me to understand!

Just one quick question, is it possible to easy adjust the code so that for each column in the range, it only starts to fill data from first occuring numeric value in the each column as the starting values differ significantly accross series.

So for example, all columns will contain a header in row but for some columns the actual data series only begins seveal rows later. Currently these are being filled with column titles as there is actually no previous actual data, just empty cells and header at the top.

So for rngCellInCol but - can we say find first value from row 1 and then only fill from that point onwards?

Thanks,

Skywalker

Try this tweak
[VBA]
For Each cel In RngRowCells
If cel.Offset.End(xlUp).Row <> 1 Then
cel = cel.Offset.End(xlUp)
cel.Font.ColorIndex = 3
End If
Next

[/VBA]

Hi Mdmackillop,

When I try running the code, excel just hangs for several minutes, when I click on escape then it shows the fellow error message: "Unable to get the specialcells properties of the range class". Debugging takes me to this line:

Set RngRowCells = Intersect(rngCellInCol.Resize(, lastcol + 1), .Cells.SpecialCells(xlCellTypeBlanks))

Here's the macro that I am using. Note when I run GTO's version on the same dataset, the macro runs fine (aside from populating rows with column headers).

Thanks,

Skywalker
------------------------------------------
[VBA]
Sub FillMissingME_Latest()
Dim wks As Worksheet
Dim rngInitial As Range
Dim rcell As Range
Dim rngLCol As Range
Dim rngCellInCol As Range
Dim rngCellInRow As Range
Dim RngRowCells As Range
Dim cel As Range
Dim rngRow As Range
Dim i As Long
Dim bolFoundAVal As Boolean

Set wks = Worksheets("Sheet1") '<---Change to suit
'Application.ScreenUpdating = False

'To define ranges - looks for any cell with value in it - from row 2 to last row and last column
With wks

' Dim lastcell, lastcol As Integer
lastcol = Range("a1").End(xlToRight).Column
'lastcell = Range("a10000").End(xlUp).Row
'Set rngLCol = Range(Cells(1, 1), Cells(lastcell, lastcol))
Set rngLCol = .Range(.Cells(1, 1), _
.Cells(Rows.Count, Columns.Count)) _
.Find(What:="*", _
After:=.Cells(Rows.Count, Columns.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)

'MsgBox rngLCol.Address(False, False)
'rngInitial' refers to Col A with rows with yes

.Columns(2).AutoFilter 1, "ME"

'Sets a reference to a non-contiguous range - rnginital is rows that have criteria in them
Set rngInitial = .Range("b2:b" & .Cells(Rows.Count, 1).End(xlUp).Row) _
.SpecialCells(xlCellTypeVisible)
.Range("b:b").AutoFilter

'checks cells in rnginitial - these are rows with yes in them, ignores all other from colum B
For Each rngCellInCol In rngInitial
Set RngRowCells = Intersect(rngCellInCol.Resize(, lastcol + 1), .Cells.SpecialCells(xlCellTypeBlanks))
For Each cel In RngRowCells
If cel.Offset.End(xlUp).Row <> 1 Then
cel = cel.Offset.End(xlUp)
cel.Font.ColorIndex = 3
'Next

'If Not RngRowCells Is Nothing Then
' For Each cel In RngRowCells
' cel = cel.Offset.End(xlUp)
' cel.Font.ColorIndex = 3

End If
Next
Next
End With
End Sub
[/VBA]

For some reason, you have deleted this If code
[VBA]
If Not RngRowCells Is Nothing Then
[/VBA]You appear to be working with a different sample, so I can't test.