Formula or VBA to populate blank cells

OfficeUser

Well-known Member
Joined
Feb 4, 2010
Messages
542
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hopefully I can explain properly, so here goes.

In column A:C I have data in some cells while others are blank.

Red Q301
Blue2
GreenQX703
YellowQX703
WhiteFX50S4
PurpleQ505
BlackFX356
Gray6
White6
Orange6
TealQX807
Violet8
TanQ509

<colgroup><col span="2"><col></colgroup><tbody>
</tbody>

I am looking for a way to look at the row the blank cell is in, compare the value in C to the one above it, and if the same populate the value in B with the one above it. It would look like this:

Red Q301
Blue2
GreenQX703
YellowQX703
WhiteFX50S4
PurpleQ505
BlackFX356
GrayFX356
WhiteFX356
OrangeFX356
TealQX807
Violet8
TanQ509

<colgroup><col span="2"><col></colgroup><tbody>
</tbody>

If they dont match then it simply stays blank. I would want to do this for rows 1:10000. Any ideas how to do this using a formula or a macro? Thank You!
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Here's a macro you can try. Assumes data starts A1.
Code:
Sub OfficeUser()
Dim c As Range
On Error Resume Next
Application.ScreenUpdating = False
For Each c In Range("B:B").SpecialCells(xlCellTypeBlanks)
    If c.Offset(0, 1).Value = c.Offset(-1, 1).Value Then c.Value = c.Offset(-1, 0).Value
Next c
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Assuming your data starts in row 2:
Code:
Sub CopyCell()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Range("B2:B" & LastRow)
        If rng = "" Then
            If rng.Offset(0, 1) = rng.Offset(-1, 1) Then
                rng = rng.Offset(-1, 0)
            End If
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Both work well, I just need to figure out how to speed them up. I am using this instead but still very slow. Thanks to you both, I appreciate it!!
Code:
[COLOR=#333333]For Each rng In Range("B2:B10000")[/COLOR]
 
Upvote 0
Both work well, I just need to figure out how to speed them up. I am using this instead but still very slow. Thanks to you both, I appreciate it!!
Code:
[COLOR=#333333]For Each rng In Range("B2:B10000")[/COLOR]

I would say Mumps since he limits the last row, but not to use the loop at all.
I would say leverage the FindSpecial, and then paste the logic formula into those blank cell.
 
Upvote 0
So more like...

Code:
Sub Macro26()
'
' Macro26 Macro
'
'
   Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim rng As Range
    
    Range("B2:B" & LastRow). _
        SpecialCells(xlCellTypeBlanks).Formula = "=IF(RC[1]=R[-1]C[1],R[-1]C,"""")"
    Range("B2:B" & LastRow).Copy
    Range("B2:B" & LastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True
   
    
End Sub
 
Upvote 0
I would say Mumps since he limits the last row, but not to use the loop at all.
I would say leverage the FindSpecial, and then paste the logic formula into those blank cell.

Not sure how to remove the loop...

Edit: You beat me to the post...
 
Last edited:
Upvote 0
So more like...

Code:
Sub Macro26()
'
' Macro26 Macro
'
'
   Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Dim rng As Range
    
    Range("B2:B" & LastRow). _
        SpecialCells(xlCellTypeBlanks).Formula = "=IF(RC[1]=R[-1]C[1],R[-1]C,"""")"
    Range("B2:B" & LastRow).Copy
    Range("B2:B" & LastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    Application.ScreenUpdating = True
   
    
End Sub

Works much faster. Thanks!
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top