Solved: Fill the blank cell

[slamet Harto]

Dear Master,

Please help to advice the vba code if I want to filled in the blank cell in selected area. please have a look into the attached file.

Many thank in advance,
Rgds, harto

[anandbohra]

far ago come across this code (not mine & even dont remember the source) but the most important thing is this code will fill all the blank row with the data in upper cells or last found cell & also this work across the columns so u can select any area of row X column & run fillemptyblockcells macro

the change I made is just added my name in title else whole code is untouched & as is it provided by original author ( sorry forgot to preserve site address)

here is the code.
[VBA]
'this is advance feature of FIll BLanks Addin
Option Base 1
Dim LastRowWithData
Dim LastColWithData
Dim aryData()
Public Sub FillEmptyBlockCells()
' This macro will perform the function as described in the initial dialog below.
On Error GoTo ERROR_HANDLER
FillCount = 0
Count = 0
' Startup Dialog
'vbCrLf used to insert next line in message box
Btn = MsgBox("This macro will FILL ANY EMPTY CELLS in the area" & vbCrLf & _
"of the screen you have selected with your mouse -- " & vbCrLf & _
"with the value of the cell above it." & vbCrLf & vbCrLf & _
" Do you WISH TO PROCEED??", vbQuestion + vbOKCancel, _
"Anand M. Bohra")
If Btn = vbCancel Then GoTo FINAL_BYE
' Place at start of macro
Application.ScreenUpdating = False
MacroStartTime = Now ' Start Elapsed Timer
Set rng = Intersect(Columns(1), Selection.EntireRow).EntireRow
MySelectedRows = rng.Address ' Returns rows contained in selection in form $10:$14 or if only one $10:$10
ColonPos = InStr(MySelectedRows, ":")
' Determine first selected row
FirstSelectedRow = Val(Mid(MySelectedRows, 2, ColonPos - 2))
' Determine Last Selected Row
LastSelectedRow = Val(Mid(MySelectedRows, ColonPos + 2, Len(MySelectedRows) - (ColonPos + 1)))
Set rng = Intersect(Rows(1), Selection.EntireColumn).EntireColumn
MySelectedColumns = rng.Address ' Returns columns contained in selection in form $D:$G or if only one $F:$F
ColonPos = InStr(MySelectedColumns, ":")
FirstSelectedColumn = Mid(MySelectedColumns, 2, ColonPos - 2)
' Determine First Selected Column
FirstColumnNumber = range(FirstSelectedColumn & "1").Column ' Numbers more useful for looping purposes
LastSelectedColumn = Mid(MySelectedColumns, ColonPos + 2, Len(MySelectedColumns) - (ColonPos + 1))
' Determine Last Selected Column
LastColumnNumber = range(LastSelectedColumn & "1").Column ' Number of last selected column
If (FirstColumnNumber = LastColumnNumber) And (FirstSelectedRow = LastSelectedRow) Then
MsgBox "This macro is meant for a BLOCK of Selected Data!" & vbCrLf & vbCrLf & _
"Will NOT work if only a single cell or no cells selected.", vbOKOnly, _
" Area Selection Error"
Exit Sub
End If
OUTERLOOP:
PriorValue = ""
For i = FirstColumnNumber To LastColumnNumber
For j = FirstSelectedRow To LastSelectedRow
Cells(j, i).Select
Temp = ActiveCell.Value
Temp = TrimSelection(Temp)
If Len(Temp) > 0 Then
PriorValue = Temp
ElseIf Len(PriorValue) > 0 Then
ActiveCell.Value = PriorValue
FillCount = FillCount + 1
End If
If j = LastSelectedRow Then PriorValue = ""
Application.StatusBar = " . . . . . . . . . . . . . . . . . . Scanning Row:" & str(j)
Next
Next
Application.StatusBar = ""
BYE:
Application.ScreenUpdating = True
' This goes in the message area
MacroEndTime = Now
ElapsedTime = CrunchTime(MacroStartTime, MacroEndTime)
MsgBox "There were" & str(FillCount) & " Cells Filled with Data from Above." & vbCrLf & vbCrLf & _
ElapsedTime, vbOKOnly, " FILL PROCESS COMPLETE!"
FINAL_BYE:
Exit Sub
ERROR_HANDLER:
Btn = MyErrorHandler(Err.Source, Err.Number, Err.Description)
End Sub

Private Function MyErrorHandler(ErrSource, ErrNum, ErrDesc)
MsgBox "Following ERROR has been detected:" & vbCrLf & vbCrLf + _
"Error Number = " & str(ErrNum) & vbCrLf & vbCrLf & _
"Error Description = " & ErrDesc, vbExclamation + vbOKOnly, _
" " & ErrSource & " -- ERROR!"
End Function

Private Function TrimSelection(ByVal Temp As String)
Dim L As String
Dim R As String
Sp = Chr(32)
Rtn = Chr(13)
Tb = Chr(9)
Rtt = Chr(10)
Ltb = Chr(7)
TRIM_LOOP:
L = Left(Temp, 1)
R = Right(Temp, 1)
If (L = Sp) Or (L = Rtn) Or (L = Tb) Or (L = Rtt) Or (L = Ltb) Then
Temp = Right(Temp, Len(Temp) - 1)
GoTo TRIM_LOOP
ElseIf (R = Sp) Or (R = Rtn) Or (R = Tb) Or (R = Rtt) Or (R = Ltb) Then
Temp = Left(Temp, Len(Temp) - 1)
GoTo TRIM_LOOP
End If
TrimSelection = Temp
End Function

Private Function CrunchTime(StartTime, EndTime)
ElapsedSeconds = DateDiff("s", StartTime, EndTime)
If ElapsedSeconds > 60 Then
ElapsedSeconds = ElapsedSeconds Mod 60
End If
ElapsedMinutes = DateDiff("n", StartTime, EndTime)
If ElapsedMinutes = 0 Then
CrunchTime = "Elapsed time was " & ElapsedSeconds & " seconds!"
Exit Function
Else
CrunchTime = "Elapsed time was " & ElapsedMinutes & _
" minutes and " & ElapsedSeconds & " seconds!"
Exit Function
End If
End Function

Public Sub LastCellsWithData()
' ExcelLastCell is what Excel thinks is the last cell
Set ExcelLastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)

' Determine the last row with data in it (must also copy above para for this to work)
Row = ExcelLastCell.Row
Do While Application.CountA(ActiveSheet.Rows(Row)) = 0 And Row <> 1
Row = Row - 1
Loop
LastRowWithData = Row ' Row number

' Determine the last column with data in it
Col = ExcelLastCell.Column
Do While Application.CountA(ActiveSheet.Columns(Col)) = 0 And Col <> 1
Col = Col - 1
Loop
LastColWithData = Col ' Column number

' Selects the Last Cell
Cells(LastRowWithData, LastColWithData).Select
End Sub
[/VBA]


hope it works as I didnt check your attachment as my office (corporate office ) does not allow me to download from this site.

[Bob Phillips]

[vba]

Sub FilledInTheBlanksCell()
Dim i As Long
Dim LastRow As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 2 To LastRow

If .Cells(i, "B").Value = "" Then

.Cells(i, "B").Value = .Cells(i - 1, "B").Value
End If
Next i
End With

End Sub
[/vba]

[slamet Harto]

Work fine! Thanks All.
This is wonderful place that i've ever had.

Thank you so much.
Best, Harto