VBA to copy down data for blank cells - repeat for entire data set.

[Trebor200]

Hi All, due to the way the raw data file is presented where duplicate values are merged, i have the need to find blank rows and coipy down data.. example below of raw data with expected results..

Thank you for your help.

VBA Query.xlsx
	A	B	C	D	E	F	G	H	I	J
1	Raw Data					Formatted data
2	ID	Date	Number	Descr		ID	Date	Number	Descr
3	8126491	06/03/2017	6910209	ABC123		8126491	06/03/2017	6910209	ABC123
4	8509133	13/09/2018				8509133	13/09/2018	6910209	ABC123	Data Copied down
5	8509133	13/09/2018				8509133	13/09/2018	6910209	ABC123	Data Copied down
6	8529818	04/10/2018	7321000	ABC345		8529818	04/10/2018	7321000	ABC345
7	8529818	05/10/2018				8529818	05/10/2018	7321000	ABC345	Data Copied down
8	8529818	05/10/2018				8529818	05/10/2018	7321000	ABC345	Data Copied down
9	8529818	05/10/2018				8529818	05/10/2018	7321000	ABC345	Data Copied down
10	8583030	22/02/2019	7682566	ABBB		8583030	22/02/2019	7682566	ABBB
11	8870685	07/05/2020	7970956	GGHJJJ		8870685	07/05/2020	7970956	GGHJJJ
12	8886527	12/08/2020	7970956	GGHJJJ		8886527	12/08/2020	7970956	GGHJJJ
13	80026735	13/08/2020	7970956	GGHJJJ		80026735	13/08/2020	7970956	GGHJJJ
14	80030607	13/08/2020	7970956	GGHJJJ		80030607	13/08/2020	7970956	GGHJJJ
15	80059734	30/04/2020	7970956	GGHJJJ		80059734	30/04/2020	7970956	GGHJJJ
16	80077337	29/06/2020	7970956	GGHJJJ		80077337	29/06/2020	7970956	GGHJJJ
17	80084169	13/10/2020	7970956	GGHJJJ		80084169	13/10/2020	7970956	GGHJJJ
18	80092361	29/10/2020	7970260	GHKIYUML		80092361	29/10/2020	7970260	GHKIYUML
19	80143972	17/08/2021	7486852	GDHDYEYYE		80143972	17/08/2021	7486852	GDHDYEYYE
20	80150183	27/08/2020	7254399	JSJSJSJJS		80150183	27/08/2020	7254399	JSJSJSJJS
21	80153337	11/09/2020	7714398	KSJKSKSKI		80153337	11/09/2020	7714398	KSJKSKSKI
22	80170505	01/10/2020	7419515	KJSJSYYEW		80170505	01/10/2020	7419515	KJSJSYYEW
23	80210063	04/01/2021				80210063	04/01/2021	7419515	KJSJSYYEW	Data Copied down
24	80210063	08/01/2021	7692106	BSTEBB		80210063	08/01/2021	7692106	BSTEBB
25	80259866	11/05/2021	7970260	ASRWGH		80259866	11/05/2021	7970260	ASRWGH
26	80262505	04/03/2021	7772620	DDDDD		80262505	04/03/2021	7772620	DDDDD
27	80265282	09/03/2021	7772620	DDDDD		80265282	09/03/2021	7772620	DDDDD
28	80269647	16/03/2021	7772620	DDDDD		80269647	16/03/2021	7772620	DDDDD
29	80269664	07/04/2021	7970260	WQDQWD		80269664	07/04/2021	7970260	WQDQWD
30	80273545	22/03/2021	7970956	WQDQWD		80273545	22/03/2021	7970956	WQDQWD
31	80274595	07/04/2021	7772620	WQDQWD		80274595	07/04/2021	7772620	WQDQWD
32	80275368	01/06/2021	7970956	WQDQWD		80275368	01/06/2021	7970956	WQDQWD
33	80285559	17/06/2021	7772620	WQDQWD		80285559	17/06/2021	7772620	WQDQWD
Sheet1

 

[Fluff]

How about

Sub trebor()
   With Range("C3:D" & Range("A" & Rows.Count).End(xlUp).Row)
      .SpecialCells(xlBlanks).FormulaR1C1 = "=r[-1]c"
      .Value = .Value
   End With
End Sub

 

[Trebor200]

How about

Sub trebor()
   With Range("C3:D" & Range("A" & Rows.Count).End(xlUp).Row)
      .SpecialCells(xlBlanks).FormulaR1C1 = "=r[-1]c"
      .Value = .Value
   End With
End Sub

Hi thanks for quick reply.. i have tried this and get a run time 1004 error - stops at .SpecialCells(xlBlanks).FormulaR1C1 = "=r[-1]c" i am using O365

 

[Marc L]

Hi, according to the attachment for starters :​

Sub Demo1()
                 Dim Rg As Range
    With Range("C3:D" & [A1].CurrentRegion.Rows.Count)
        If Application.CountA(.Cells) < .Cells.CountLarge Then
            Application.ScreenUpdating = False
            For Each Rg In .SpecialCells(4).Areas:  Rg.Rows(0).Copy Rg:  Next
            Application.ScreenUpdating = True
        End If
    End With
End Sub

 

[Fluff]

i have tried this and get a run time 1004 error

What was the error message?

 

[Trebor200]

What was the error message?

No Cells were found

 

[Trebor200]

Hi, according to the attachment for starters :​

Sub Demo1()
                 Dim Rg As Range
    With Range("C3:D" & [A1].CurrentRegion.Rows.Count)
        If Application.CountA(.Cells) < .Cells.CountLarge Then
            Application.ScreenUpdating = False
            For Each Rg In .SpecialCells(4).Areas:  Rg.Rows(0).Copy Rg:  Next
            Application.ScreenUpdating = True
        End If
    End With
End Sub

Thanks reply, code runs but finishes without doing anything ?

 

[Marc L]

​

As my demonstration well works with your attachment so your 'blank' cells are not really blank …​

If any other helper find a way I will need you link your workbook on a files host website like Dropbox …​

 

[Fluff]

No Cells were found

Then the cells are not empty. In another cell put

=CODE(C4)

change the C4 to one of the "empty" cells, what does it return?

 

[Trebor200]

Then the cells are not empty. In another cell put

=CODE(C4)

change the C4 to one of the "empty" cells, what does it return?

Hi #Value! file here https://www.dropbox.com/s/us15wbsbkpjpoo8/VBA%20Query%202.xlsm?dl=0