Excel list VBA concatenate - excel

Question

Image below shows an Excel list I have. Columns A-C is the contents I have. Columns D and E is the result I'm looking for. I've manually entered it to show the result.
Currently my code looks like this:
Option Explicit
Sub New_SKU()
Dim wb As Workbook
Dim ws As Worksheet
'figure out how far down data goes
Dim endrow As Long
Dim currentrow As Long
Dim basename
Set wb = ThisWorkbook
Set ws = wb.Sheets("Blad1")
With ws
endrow = .Cells(.Rows.Count, "A").End(xlUp).Row
'always start in the correct column
.Cells(.Cells(1, "B").End(xlDown).Row, "B").Activate
'loop through all data
Do While ActiveCell.Row < endrow
'loop through empty cells and set formula if cell isn't empty
Do While ActiveCell.Row <= endrow
'if next cell isn't empty, isn't past the end of the list, go to outer loop
If ActiveCell.Formula <> "" And ActiveCell.Offset(1, 0).Formula = "" And ActiveCell.Row <= endrow Then
basename = Selection.Address
ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
' If ActiveCell.Formula = "" And ActiveCell.Offset(0, 1).Formula <> "" And ActiveCell.Row <= endrow Then
' ActiveCell.Offset(0, 2).Formula = "=CONCATENATE(" & basename & ",""-""," & "C" & Selection.Row & ")"
' ActiveCell.Offset(0, 3).Formula = "=" & basename & ""
' ActiveCell.Offset(1, 0).Activate
Else
Exit Do
End If
' End If
' End If
' End If
' End If
' End If
Loop
Loop
End With
End Sub
I am reusing code from a similar problem I received help with earlier.
My first problem:
If uncomment the If-statements, when I start the script Excel goes blank (white) and stalls immediatly.
Running the script in its current state (If-satements commented out), I can see that I get the correct result in cell D2 and then cell B3 is selected (keep in mind that there are no results in column D or E), and then the screen goes blank and Excel stalls. I do not get any result in column E.
Since there are variation in sizes (column C), it can vary from 2-3 to 5-6.
I cannot figure out why I won't receive a result in E-column and why it stalls and goes white.
Any ideas?

Answer 1

As per comment above, here is a different approach
Sub x()
Dim r As Long
Columns(2).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]c"
For r = 2 To Range("A" & Rows.Count).End(xlUp).Row
Cells(r, 4).Value = Cells(r, 2).Value & "-" & Cells(r, 3).Value
Cells(r, 5).Value = Cells(r, 2).Value
Next r
Columns(2).SpecialCells(xlCellTypeFormulas).ClearContents
End Sub

Answer 2

If you're okay with a non-VBA answer, you can paste this formula in D2 and copy down:
=IF(B2="",LEFT(D1,FIND("-",D1)-1)&"-"&C2,B2&"-"&C2)