vba help - Fill Blank cells of above date

[Mallesh23]

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
	A	B	C	D	E
1	Date	Company		Date	Company
2	05/10/2020	ABC		05/10/2020	ABC
3		Agst Ref		05/10/2020	Agst Ref
4		XXX		05/10/2020	XXX
5	08/10/2020	XYZ		08/10/2020	XYZ
6		ABC		08/10/2020	ABC
7		XXX		08/10/2020	XXX
8	12/10/2020	PQR		12/10/2020	PQR
9		Agst Ref		12/10/2020	Agst Ref
10		XXX		12/10/2020	XXX
11		XXX		12/10/2020	XXX
12		XXX		12/10/2020	XXX
13		XXX		12/10/2020	XXX
14		XXX		12/10/2020	XXX
15		XXX		12/10/2020	XXX
16		XXX		12/10/2020	XXX
17	13/10/2020	RST		13/10/2020	RST
18		xxx		13/10/2020	xxx
19		xxx		13/10/2020	xxx
20		xxx		13/10/2020	xxx
21	23/10/2020	DEF		23/10/2020	DEF
22		Agst Ref		23/10/2020	Agst Ref
23		Agst Ref		23/10/2020	Agst Ref
24		Agst Ref		23/10/2020	Agst Ref
Sheet1

Thanks
mg

 

[MARK858]

Try one of the codes below.

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

 

[Mallesh23]

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
	A	B
1	Date	Company
2	05/10/2020	ABC
3	05/10/2020	Agst Ref
4		XXX
5	08/10/2020	XYZ
6	08/10/2020	ABC
7		XXX
8	12/10/2020	PQR
9	12/10/2020	Agst Ref
10		XXX
11		XXX
12		XXX
13		XXX
14		XXX
Sheet1

Thanks
mg

 

[Mallesh23]

Hi Mark,

I have used below code its working.

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
	A	B	C
1	Date	Company	Format of A columns CELL
2	01/09/2020	ABC
3		XXX
4		XYZ
5		ABC
6		XXX
7		PQR	Text format
8	01/09/2020	Agst Ref
9		XXX
10		XXX
11	01/09/2020	XXX
12		XXX	Text format
13	01/09/2020	XXX
14		XXX
15		XXX	Text format
16		RST	Text format
17		xxx
18	01/09/2020	xxx
19		xxx	Text format
20	02/09/2020	DEF
21		Agst Ref
22		Agst Ref	Text format
23		Agst Ref	Text format
Sheet1

Thanks
mg

 

[MARK858]

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.

 

[Mallesh23]

Hi Mark,

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




Thanks
mg

 

[MARK858]

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.

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

 

[Mallesh23]

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
	A	B
1	Date	Company
2		ABC
3	01/09/2020	XXX
4		XYZ
5		ABC
6		XXX
7		PQR
8		Agst Ref
9	01/09/2020	XXX
10		XXX
11		XXX
12	01/09/2020	XXX
13		XXX
14	01/09/2020	XXX
15		XXX
16		RST
17		xxx
18		xxx
19	01/09/2020	xxx
20		DEF
21	02/09/2020	Agst Ref
22		Agst Ref
23		Agst Ref
24
25
26	02/09/2020
27
28
29
30
31	02/09/2020
32
33
34
35
36	02/09/2020
37
38
39
40
41	02/09/2020
Sheet2

Thanks
mg

 

[MARK858]

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?

 

[Mallesh23]

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
	A	B	C	D	E
1	Date	Company	Format of A columns CELL		Blank Check ColumnA
2	01/09/2020	ABC			FALSE
3		XXX			TRUE
4		XYZ			TRUE
5		ABC			TRUE
6		XXX			TRUE
7		PQR	Text format		TRUE
8		Agst Ref			FALSE
9	01/09/2020	XXX			FALSE
10		XXX			TRUE
11		XXX			FALSE
12	01/09/2020	XXX	Text format		FALSE
13		XXX			FALSE
Sheet2

Cell Formulas
Range	Formula
E2:E13	E2	=ISBLANK(A2)

Thanks
mg