Select the last filled cell from the referenced column

Question

I am trying to find a last empty column and writing the column name. The code find this new column by it's name and selects the second cell and paste the values from Column B and Column C till exceldown. But, the code fills all the blank cells of column D with hyphen "-". I want to somehow define the last filled cell and paste till last filled cell of Column B only. I am facing syntax errors. Any lead how do I achieve it? Thank you!

Sheet " FruitsVege "

	A	B	C
1	Category	Fruits	Vegetables
2	Blank	Apple	Spinach
3	Blank	Orange	Cabbage

Desired Result in Sheet " FruitsVege "

	A	B	C	D
1	Category	Fruits	Vegetables	FruitsVege
2	Blank	Apple	Spinach	Apple-Spinach
3	Blank	Orange	Cabbage	Orange-Cabbage

The Code

Sub Merge_FV ()
  
Dim r1 As Range, r2 As Range, r3 As Range

Dim emptyColumn As Long


'find empty Column (actually cell in Row 1)'
emptyColumn = Cells(1, Columns.Count).End(xlToLeft).Column
If emptyColumn > 1 Then
emptyColumn = emptyColumn + 1
End If

 Cells(1, emptyColumn).Value = "FruitsVege"

With Rows(1)
    Set r1 = .Find(What:="Fruits", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    Set r2 = .Find(What:="Vegetables", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    Set r3 = .Find(What:="FruitsVege", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
     If Not r1 Is Nothing And Not r2 Is Nothing And Not r3 Is Nothing Then
         r3.Offset(1, 0).Select
         Range(ActiveCell, ActiveCell.End(xlDown)).Formula = "=" & r1.Offset(1).Address(0, 0) & " & ""-"" & " & r2.Offset(1).Address(0, 0)
    End If
End With

     
End Sub

Answer 1

Not tested but should work - I have just amended the formula line. You need to find the last row by working up from the bottom of the sheet, and there is no need to select anything.

Sub Merge_FV()
  
Dim r1 As Range, r2 As Range, r3 As Range

Dim emptyColumn As Long, LastRow As Long

'find empty Column (actually cell in Row 1)'
emptyColumn = Cells(1, Columns.Count).End(xlToLeft).Column
If emptyColumn > 1 Then
    emptyColumn = emptyColumn + 1
End If

Cells(1, emptyColumn).Value = "FruitsVege"

With Rows(1)
    Set r1 = .Find(What:="Fruits", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    Set r2 = .Find(What:="Vegetables", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    Set r3 = .Find(What:="FruitsVege", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not r1 Is Nothing And Not r2 Is Nothing And Not r3 Is Nothing Then
        LastRow = Cells(Rows.Count, r1.Column).End(xlUp).Row
        r3.Offset(1, 0).Resize(LastRow - 1).Formula = "=" & r1.Offset(1).Address(0, 0) & " & ""-"" & " & r2.Offset(1).Address(0, 0)
    End If
End With

End Sub