Thread: A repost - Permuting SPACES within a String of words
View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Hari Hari is offline
external usenet poster
  
Posts: 46
Default A repost - Permuting SPACES within a String of words
Hi,
I have written an inefficient code (below) of accomplishing what I want
to do. Could anybody help me in shortening it up. Also, presently I
have considered only till 5 words in the original string. For 6 word
combination I will have to write down 32 lines of code more (rather
32*3) and so on. Can this code be made Dynamic.?

Option Explicit

Sub MakeMeMessy()
Dim i As Integer
Dim lastRow As Integer

Range("i2:j65536").Select
Selection.ClearContents

lastRow = Range("AF65536").End(xlUp).Row
Cells(2, "i").Select
For i = 2 To lastRow

Splitwords ActiveSheet.Cells(i, "af").Value

Select Case UBound(arrWords) - LBound(arrWords)

Case 0
ActiveCell.Value = arrWords(LBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
Case 1
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
Case 2
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & " " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & " " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
Case 3
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
" " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) & " " &
arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
" " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) &
arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) & " " &
arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) &
arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
Case 4
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
" " & arrWords(LBound(arrWords) + 3) & " " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
" " & arrWords(LBound(arrWords) + 3) & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
arrWords(LBound(arrWords) + 3) & " " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) & " " &
arrWords(LBound(arrWords) + 3) & " " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
" " & arrWords(LBound(arrWords) + 3) & " " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
arrWords(LBound(arrWords) + 3) & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) &
arrWords(LBound(arrWords) + 3) & " " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) & " " &
arrWords(LBound(arrWords) + 3) & " " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
arrWords(LBound(arrWords) + 3) & " " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
" " & arrWords(LBound(arrWords) + 3) & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) & " " &
arrWords(LBound(arrWords) + 3) & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) & " " &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) &
arrWords(LBound(arrWords) + 3) & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & " " & arrWords(LBound(arrWords) + 2) &
arrWords(LBound(arrWords) + 3) & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) & " " &
arrWords(LBound(arrWords) + 3) & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) &
arrWords(LBound(arrWords) + 3) & " " & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveCell.Value = arrWords(LBound(arrWords)) &
arrWords(LBound(arrWords) + 1) & arrWords(LBound(arrWords) + 2) &
arrWords(LBound(arrWords) + 3) & arrWords(UBound(arrWords))
ActiveCell.Offset(0, 1).Range("A1").Value = Cells(i,
"ag").Value
ActiveCell.Offset(1, 0).Range("A1").Select
End Select

Next i


End Sub


Public Sub Splitwords(sText As String)

Dim x As Integer
Dim arrReplace As Variant

arrReplace = Array(vbTab, ":", ";", ".", ",", "-", "/", "\",
Chr(10), Chr(13))
For x = LBound(arrReplace) To UBound(arrReplace)
sText = Replace(sText, arrReplace(x), " ")
Next x

arrWords = Split(Application.WorksheetFunction.Trim(sText), " ")

End Sub

Regards,
Hari
India

Reply With QuoteReply With Quote