Hi All
I have prepaired this code to find blank cell in column "B" after a subtotal is done on the sheet. and merge cell and the lookup values on another tab.
This works great but, only does the first blank cell in column B and need it to find all the blank cells on the sheet and import the lookup.
not sure if looping will be good or if there is anything that i can change on this code to complete the task.
Your help would be very much appriciated.
MIG285
Code
Sub FindBlank()
Dim r1 As RANGE, r2 As RANGE
Set r1 = Intersect(RANGE("B:B"), Cells.SpecialCells(xlCellTypeBlanks))
Set r2 = Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
If r1 Is Nothing Then
r2.Select
Else
r1(1).Select
End If
ActiveCell.Resize(, 11).Merge
ActiveCell.Offset(, 7).Select
ActiveCell.Resize(, 19).Merge
r1(1).Select
ActiveCell.FormulaR1C1 = "=LOOKUP(Supp!C[-1]:C[11],Supp!C)"
RANGE("B3:L3").HorizontalAlignment = xlCenter
RANGE("B3:L3").Style = "Currency"
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveCell.Offset(, 7).Select
ActiveCell.FormulaR1C1 = "=LOOKUP(RC[-18],Supp!C[-18]:C[-6],Supp!C[-8])"
RANGE("S3:AK3").HorizontalAlignment = xlCenter
Loop
End Sub
Display More