Auto fill a formula down a column but skipping already populated cells-CodePudding

After numerous failed attempts I am really hoping someone can with my problem. It theory what I am trying to do sounds easy enough but I have spent hours on it today with no success.

I have tried all the possible solutions from this thread but to no avail: Excel vba Autofill only empty cells

Also looked here : https://www.mrexcel.com/board/threads/macro-to-copy-cell-value-down-until-next-non-blank-cell.660608/

I am looking to autofill a formula down a column(a vlookup from another sheet) but if there is already populated cells then to skip and continue the formula in the next available blank cell. For example, in rows A2:A10, row A5 has a value in it, so the formula gets into in A2, then fills to A4, then skips A5, then continues in A6 to A10.

This below code works the first time you use it but then on the second run it debugs with a "Run-time error '1004' - No cells were found". I noticed it it putting the formula into the first cell (B2) and then debugging out.

Sub FillDownFormulaOnlyBlankCells()
Dim wb As Workbook
Dim ws1, ws2 As Worksheet
Dim rDest As Range
Set wb = ThisWorkbook

Set ws1 = Sheets("Copy From")
Set ws2 = Sheets("Copy To")

ws2.Range("A1").Formula = "=IFERROR(IF(VLOOKUP(A2,'Copy From'!A:B,2,FALSE)=0,"""",VLOOKUP(A2,'Copy From'!A:B,2,FALSE)),"""")"

Set rDest = Intersect(ActiveSheet.UsedRange, Range("B2:B300").Cells.SpecialCells(xlCellTypeBlanks))

ws2.Range("B2").Copy rDest

End Sub

CodePudding user response：

Please, try the next code:

Sub FillDownFormulaOnlyBlankCells()
 Dim wb As Workbook, ws1 As Worksheet, rngBlanc As Range

 Set wb = ThisWorkbook
 Set ws1 = wb.Sheets("Copy From")

 On Error Resume Next
  Set rngBlanc = ws1.Range("B2:B" & ws1.rows.count.End(xlUp).row).SpecialCells(xlCellTypeBlanks)
 On Error GoTo 0
 
 If Not rngBlanc Is Nothing Then
        rngBlanc.Formula = "=IFERROR(IF(VLOOKUP(A2,'Copy From'!A:B,2,FALSE)=0,"""",VLOOKUP(A2,'Copy From'!A:B,2,FALSE)),"""")"
 Else
    MsgBox "No blanc rows exist in B:B column..."
 End If
End Sub

After running it once and do not create any empty cell, of course there will not be any blanc cells, anymore, at a second run...

CodePudding user response：

Thanks to FaneDuru for his suggestion but I actually came up with an alternative solution to my problem which I though I would post as it might help others with a similar issue.

On a separate sheet, I created 3 columns, first column is names I already have, 2nd column are the new names and the 3rd column is there to combine the first 2 columns together, then use this code to combine first 2 columns :

Sub MergeColumns()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim LastRow As Long, i As Long

Set ws1 = Sheets("Your Sheet Name")

LastRow = ws1.Range("F" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow

If ws1.Range("G" & i) <> "" Then
    ws1.Range("I" & i) = ws1.Range("H" & i).Text & "" & ws1.Range("G" & i).Text
    Else: ws1.Range("I" & i) = ws1.Range("H" & i)

End If
Next i

End Sub

Obviously changing the sheet name and columns letter to suit your requirements.