Loop A Macro

[Ranjith Edakkatt]

Dear All,
I have an excel data with date, source and SR number. In some cells of date and source is blank, in these case I need to copy the data of above cells and also needs to repeat the same until the SR number becomes blank. Table given below. Thanks in advance.

[TABLE="class: grid, width: 100, align: center"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Source[/TD]
[TD]SR_No[/TD]
[/TR]
[TR]
[TD]13/2/2017[/TD]
[TD]PBU[/TD]
[TD]1-567[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]1-568[/TD]
[/TR]
[TR]
[TD]11/2/2017[/TD]
[TD]PBU[/TD]
[TD]1-896[/TD]
[/TR]
[TR]
[TD]10/2/2017[/TD]
[TD]PBU[/TD]
[TD]1-854[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]1-856[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]1-874[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]1-458[/TD]
[/TR]
[TR]
[TD]10/1/2017[/TD]
[TD]PBU[/TD]
[TD]1-521[/TD]
[/TR]
</tbody>[/TABLE]

 

[SQUIDD]

Hi

not sure I quite follow what you want to do.

Copy what?
copy to where
what is your existing code(if any)
what should your data look like after the code runs

thanks

dave

 

[SQUIDD]

After re reading your post

are you lookin at filling in the gaps in your data,

if so, try this on a copy of your workbook.

code assume sheet1 is your sheet
also assumes column a,b and c

Dave

Sub fill_gaps()

Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("sheet1")
LastRow = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row + 1
    For A = 1 To LastRow - 1
        If Range("'sheet1'!$A$" & A) = "" Then Range("'sheet1'!$A$" & A) = CDate(Range("'sheet1'!$A$" & A - 1))
        If Range("'sheet1'!$B$" & A) = "" Then Range("'sheet1'!$B$" & A) = Range("'sheet1'!$B$" & A - 1)
    Next
End Sub

 

[Ranjith Edakkatt]

Thanks Dave for your response.

Here your clarification.

Copy what? - Copy the data from just the above cell of respective column if its not blank.
Copy to where - In only blank cells.

what is your existing code(if any) - code mentioned below, I need to repeat the same until the SR number becomes blank.


Range("A1").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.Offset(-1, 0).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown

 

[SQUIDD]

Hi

Did you see my post 3, i think after re-reading i understood what you needed.
Try the code from post 3 on a copy of your workbook.

good luck and let me know please.

Dave

 

[SQUIDD]

or this one is a bit more tidy

Sub fill_gaps()

Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("sheet1")
LastRow = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row + 1
    For A = 1 To LastRow - 1
        If Range("A" & A) = "" Then Range("A" & A) = CDate(Range("A" & A - 1))
        If Range("B" & A) = "" Then Range("B" & A) = Range("B" & A - 1)
    Next
End Sub

 

[Ranjith Edakkatt]

Thanks alot Dave, Its worked well... Really you are awesome

 

[SQUIDD]

thanks for the feedback mate.

glad it worked.

dave

 

[JackDanIce]

One other suggestion without looping to consider:

Sub fill_gaps_v1()

    Dim x       As Long
    
    With Sheets("Sheet1")
        x = .Cells(.Rows.Count, 3).End(xlUp).row
        With .Cells(1, 1).Resize(x, 2)
            .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
            .Calculate
            .Value = .Value
        End With
    End With
        
End Sub