vba help - Fill Blank cells of above date

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
976
Office Version
  1. 2010
Platform
  1. Windows
Hi Team,

Need VBA help to fill dates in Blank cells of Column A.

Expected Output shown in Column D. thanks in advance for your help.

Below is data with Expected Output.

Book1
ABCDE
1DateCompanyDateCompany
205/10/2020ABC05/10/2020ABC
3Agst Ref05/10/2020Agst Ref
4XXX05/10/2020XXX
508/10/2020XYZ08/10/2020XYZ
6ABC08/10/2020ABC
7XXX08/10/2020XXX
812/10/2020PQR12/10/2020PQR
9Agst Ref12/10/2020Agst Ref
10XXX12/10/2020XXX
11XXX12/10/2020XXX
12XXX12/10/2020XXX
13XXX12/10/2020XXX
14XXX12/10/2020XXX
15XXX12/10/2020XXX
16XXX12/10/2020XXX
1713/10/2020RST13/10/2020RST
18xxx13/10/2020xxx
19xxx13/10/2020xxx
20xxx13/10/2020xxx
2123/10/2020DEF23/10/2020DEF
22Agst Ref23/10/2020Agst Ref
23Agst Ref23/10/2020Agst Ref
24Agst Ref23/10/2020Agst Ref
Sheet1



Thanks
mg
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Try one of the codes below.

VBA Code:
Sub FillCell1()
    Dim fCell As Range
    On Error Resume Next

    For Each fCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row). _
        SpecialCells(xlCellTypeBlanks).Areas
        fCell.Value = fCell(1).Offset(-1).Value
    Next

    On Error GoTo 0
End Sub

Sub FillCell2()
    On Error Resume Next

    With Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
        .Value = .Value
    End With

    On Error GoTo 0
End Sub
 
Upvote 0
Hi Mark,

Code is working but it is filling Single cells Down.
All blank cells not fill down. Can you please check.


It is generating Below Output.
Book1
AB
1DateCompany
205/10/2020ABC
305/10/2020Agst Ref
4XXX
508/10/2020XYZ
608/10/2020ABC
7XXX
812/10/2020PQR
912/10/2020Agst Ref
10XXX
11XXX
12XXX
13XXX
14XXX
Sheet1



Thanks
mg
 
Upvote 0
Hi Mark,

I have used below code its working.

VBA Code:
Sub FillColBlanks_Offset()
 
  Dim c As Range
 
Columns(1).Numberformat = "DD/MM/YYYY"

  For Each c In Range("a2:a23")
    If c.Value <> "" Then
        If c.Offset(1).Value = "" Then
            c.Offset(1).Value = c.Value
        End If
    End If
  Next c

 
End Sub



In column A it contain Blanks cells in date format and few blank cells in Text format.
Why your code is not working, for remaining blank cells. Column A to fill blank cells.

Book1
ABC
1DateCompanyFormat of A columns CELL
201/09/2020ABC
3XXX
4XYZ
5ABC
6XXX
7PQRText format
801/09/2020Agst Ref
9XXX
10XXX
1101/09/2020XXX
12XXXText format
1301/09/2020XXX
14XXX
15XXXText format
16RSTText format
17xxx
1801/09/2020xxx
19xxxText format
2002/09/2020DEF
21Agst Ref
22Agst RefText format
23Agst RefText format
Sheet1


Thanks
mg
 
Upvote 0
In column E... in E2 put the formula =ISBLANK(A2) and drag the formula down. If you look at the formula on the lines where it didn't fill I suspect that it returns FALSE.
 
Upvote 0
Hi Mark,

Right ! Getting blank as you said . how to solve it.




Thanks
mg
 
Last edited:
Upvote 0
If it is returning FALSE then it means that your cells aren't truly blank cells. You can try running the code below to see if the formulas change to TRUE.

VBA Code:
Sub Trimit()
    Dim myCell As Range, myRng As Range
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    Set myRng = Range("A2:A" & Range("A" & Rows.count).End(xlUp).Row)
    
    With myRng
        .Replace What:=Chr(160), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(13) & Chr(10), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(13), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(21), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(8), Replacement:=Chr(32), LookAt:=xlPart
        .Replace What:=Chr(9), Replacement:=Chr(32), LookAt:=xlPart
    End With

    On Error Resume Next
    For Each myCell In Intersect(myRng, _
                                 myRng.SpecialCells(xlConstants, xlTextValues))
        myCell.Value = Application.Trim(myCell.Value)
    Next myCell
    On Error GoTo 0

    With Application
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
End Sub
 
Upvote 0
Hi Mark,

I run provided code, but Macro is not producing any output.
I am not sure where is problem is.


Tested Macro on below data.

Book8
AB
1DateCompany
2ABC
301/09/2020XXX
4XYZ
5ABC
6XXX
7PQR
8Agst Ref
901/09/2020XXX
10XXX
11XXX
1201/09/2020XXX
13XXX
1401/09/2020XXX
15XXX
16RST
17xxx
18xxx
1901/09/2020xxx
20DEF
2102/09/2020Agst Ref
22Agst Ref
23Agst Ref
24
25
2602/09/2020
27
28
29
30
3102/09/2020
32
33
34
35
3602/09/2020
37
38
39
40
4102/09/2020
Sheet2


Thanks
mg
 
Upvote 0
The macro shouldn't produce output in column A, please read what I wrote.
Any change will be to the formula in column E that I told you to put in. Have the formulas that are on the same lines as the "blank" cells changed from FALSE to TRUE?
 
Upvote 0
Hi mark,

Isblank Formula is showing mixed Response. in Column E. all values didn't turn to True.

Checked formula after running Macro.

Below is the attached data and Formula in Column E.

Book8
ABCDE
1DateCompanyFormat of A columns CELLBlank Check ColumnA
201/09/2020ABCFALSE
3XXXTRUE
4XYZTRUE
5ABCTRUE
6XXXTRUE
7PQRText formatTRUE
8Agst RefFALSE
901/09/2020XXXFALSE
10XXXTRUE
11XXXFALSE
1201/09/2020XXXText formatFALSE
13XXXFALSE
Sheet2
Cell Formulas
RangeFormula
E2:E13E2=ISBLANK(A2)


Thanks
mg
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,034
Members
448,543
Latest member
MartinLarkin

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