Replace Blanks with Underscore
Private Sub CommandButton1_Click()
Max = Range("A2").End(xlDown).Row
For r = 2 To Max
Result = Split(Range("A" & r).Value, " ")
For parts = 0 To UBound(Result)
q = q + Result(parts) & "_"
Cells(r, 2).Value = q
Next
k = Left(q, Len(q) - 1)
Cells(r, 2).Value = k
q = ""
Next
ActiveSheet.UsedRange.Columns.AutoFit
End Sub