syntax problem with a While nested into a Loop (for an Array)

[Paul_Hossler]

I think the logic is unnecessarily complicated

I did this as a user defined worksheet function, but the logic could be incorporated into a sub if you wanted to

I did have to add some data clean up since A5 had a trailing space which caused the logic to fail

This does NOT clean the input string (although it could) so if a two word entry has multiple spaces, it would miss

 
Option Explicit

Function SomeData(S As String, R As Range) As String
    Dim aryData As Variant
    Dim s1 As String, s2 As String
    Dim i As Long, j As Long
    
    'save data
    aryData = R.Value
    s1 = S
        
    'clean data
    For i = LBound(aryData, 1) To UBound(aryData, 1)
        For j = LBound(aryData, 2) To UBound(aryData, 2)
        
            'leading and trailing spaces
            aryData(i, j) = Trim(aryData(i, j))
        
            'in case there are 2 or more spaces
            Do While InStr(aryData(i, j), "  ") > 0
                aryData(i, j) = Replace(aryData(i, j), "  ", " ")
            Loop
        Next j
    Next i
        
        
    'multiple words first
    For i = LBound(aryData, 1) To UBound(aryData, 1)
        If InStr(aryData(i, 1), " ") > 0 Then
            s2 = vbNullString
            
            'build replacement string by going accross columns, skipping first col
            For j = LBound(aryData, 2) + 1 To UBound(aryData, 2)
                s2 = s2 & aryData(i, j) & " "
            Next j
            
            'remove last added space
            s2 = Left(s2, Len(s2) - 1)
            s1 = Replace(s1, aryData(i, 1), s2)
        End If
    Next i
    
    'single words
    For i = LBound(aryData, 1) To UBound(aryData, 1)
        If InStr(aryData(i, 1), " ") = 0 Then
            s2 = vbNullString
            
            'build replacement string by going accross columns, skipping first col
            For j = LBound(aryData, 2) + 1 To UBound(aryData, 2)
                s2 = s2 & aryData(i, j) & " "
            Next j
            
            'remove last added space
            s2 = Left(s2, Len(s2) - 1)
            s1 = Replace(s1, aryData(i, 1), s2)
        End If
    Next i
    
    SomeData = s1
End Function