ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   A repost - Permuting SPACES within a String of words (https://www.excelbanter.com/excel-programming/322522-re-repost-permuting-spaces-within-string-words.html)

Hari

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


Tim Williams

A repost - Permuting SPACES within a String of words
 
Hari,

I would not travel any further down this route: as you can see your
code will not scale beyond only a small number of words.

Perhaps you would get better suggestions if you could restate why you
need these permutations - there will no doubt be a betterapproach to
achieve what you want than trying to generate all possible
permutations up front. For example, you might be better served
reading a little on how Regular Expressions could help you with your
task. They are ideally suited to this kind of analysis you seem to be
doing.

Regards,
Tim.


"Hari" wrote in message
ups.com...
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




Hari Prasadh[_2_]

A repost - Permuting SPACES within a String of words
 
Hi Tim,

Im sorry, dont understand what u mean by -- Regular expressions -- Is it an
excel topic (Searched excel but couldnt find it) or is it a mathematical
topic. Please tell me.

As to what I was trying to do is compare text in column A with a base list
in column I. You have previously helped me in trying to set up a base list
in the column I. Now, as I have touched upon in some other related posts,
base list is something without TYPOS. Also, base list would have the correct
number of spaces between the words. But column A would be having typos or
would be having inconsistent spaces (Please note these inconsistent spaces
cannot be handled by Trim function etc)

I am independently trying to handle the typo though its a problem for the
long-run (time-wise).

In the present post Im handling only Space problem. For ex.

If column A has -- NetBeans --- and Column I has -- Net Beans-- then I would
like to say that the Column A and Column I are *equivalent*. As you would
see a trim function wouldnt work here.
For that what am doing is to paste the base list in Column AF and then run a
macro called MakeMeMessy (which u have seen is quite unweildy). This macro
will take each cell in Column AF and then
permute the existence and non-existence of soaces between each word in the
string and output the result to column I. Once Im able to generate all the
permutations then I run a simple Vlookup to Map the columns.

More demonstration.

***Before running the MakeMeMessy macro . FYI - ABC , BCD, EF, GY are
separate words just like Macromedia, cold, fusion are separate words.

Column AF Column AG
Advanced Revelations 23
Macromedia Cold fusion 34
ABC BCD EF GY 45

** After running the Macro

Column I Column J
Advanced Revelations 23
AdvancedRevelations 23
Macromedia Cold fusion 34
Macromedia Coldfusion 34
MacromediaCold fusion 34
MacromediaColdfusion 34
ABC BCD EF GY 45
ABC BCD EFGY 45
ABC BCDEF GY 45
ABCBCD EF GY 45
ABCBCD EFGY 45
ABCBCDEF GY 45
ABC BCDEFGY 45
ABCBCDEFGY 45



Thanks a lot,
Hari
India

"Tim Williams" <saxifrax@pacbell*dot*net wrote in message
...
Hari,

I would not travel any further down this route: as you can see your code
will not scale beyond only a small number of words.

Perhaps you would get better suggestions if you could restate why you need
these permutations - there will no doubt be a betterapproach to achieve
what you want than trying to generate all possible permutations up front.
For example, you might be better served reading a little on how Regular
Expressions could help you with your task. They are ideally suited to
this kind of analysis you seem to be doing.

Regards,
Tim.




Tim Williams

A repost - Permuting SPACES within a String of words
 
Hari,

For Regular Expressions see he
http://msdn.microsoft.com/library/de...xpressions.asp
http://www.mvps.org/dmcritchie/excel...sid.htm#RegExp

You could (instead of creating all possible permutations) use a
regular expression "pattern" which could be tested against you strings
and match regardless of the existence of spaces.

For your example of "ABC BCD EF GY" you might try something like:

Sub test()
TestMatch "I use ABC bcd EFGY in my job", "ABC\s*BCD\s*EF\s*GY"
End Sub



Sub TestMatch(sIn As String, sPatt As String)

Dim regex As Object, matches As Object, m As Object
Dim x As Integer

Set regex = CreateObject("vbscript.regexp")
regex.Pattern = sPatt
regex.Global = True
regex.ignorecase = True

Set matches = regex.Execute(sIn)
If matches.Count 0 Then
For x = 0 To matches.Count - 1
Debug.Print matches(x).Value
Next x
End If

End Sub


The pattern "ABC\s*BCD\s*EF\s*GY" will match any string containing
"ABC" folllowed by zero or more "space" characters, followed by "BCD"
and then zero or more space characters etc etc. Setting "ignorecase"
to true will also match instances where the case is not the same as
your pattern.

I think this is going to prove useful to you once you have read some
more examples - the MS link has good documentation.

Good luck
Tim.





"Hari Prasadh" wrote in message
...
Hi Tim,

Im sorry, dont understand what u mean by -- Regular expressions --
Is it an excel topic (Searched excel but couldnt find it) or is it a
mathematical topic. Please tell me.

As to what I was trying to do is compare text in column A with a
base list in column I. You have previously helped me in trying to
set up a base list in the column I. Now, as I have touched upon in
some other related posts, base list is something without TYPOS.
Also, base list would have the correct number of spaces between the
words. But column A would be having typos or would be having
inconsistent spaces (Please note these inconsistent spaces cannot be
handled by Trim function etc)

I am independently trying to handle the typo though its a problem
for the long-run (time-wise).

In the present post Im handling only Space problem. For ex.

If column A has -- NetBeans --- and Column I has -- Net Beans-- then
I would like to say that the Column A and Column I are *equivalent*.
As you would see a trim function wouldnt work here.
For that what am doing is to paste the base list in Column AF and
then run a macro called MakeMeMessy (which u have seen is quite
unweildy). This macro will take each cell in Column AF and then
permute the existence and non-existence of soaces between each word
in the string and output the result to column I. Once Im able to
generate all the permutations then I run a simple Vlookup to Map the
columns.

More demonstration.

***Before running the MakeMeMessy macro . FYI - ABC , BCD, EF, GY
are separate words just like Macromedia, cold, fusion are separate
words.

Column AF Column AG
Advanced Revelations 23
Macromedia Cold fusion 34
ABC BCD EF GY 45

** After running the Macro

Column I Column J
Advanced Revelations 23
AdvancedRevelations 23
Macromedia Cold fusion 34
Macromedia Coldfusion 34
MacromediaCold fusion 34
MacromediaColdfusion 34
ABC BCD EF GY 45
ABC BCD EFGY 45
ABC BCDEF GY 45
ABCBCD EF GY 45
ABCBCD EFGY 45
ABCBCDEF GY 45
ABC BCDEFGY 45
ABCBCDEFGY 45



Thanks a lot,
Hari
India

"Tim Williams" <saxifrax@pacbell*dot*net wrote in message
...
Hari,

I would not travel any further down this route: as you can see your
code will not scale beyond only a small number of words.

Perhaps you would get better suggestions if you could restate why
you need these permutations - there will no doubt be a
betterapproach to achieve what you want than trying to generate all
possible permutations up front. For example, you might be better
served reading a little on how Regular Expressions could help you
with your task. They are ideally suited to this kind of analysis
you seem to be doing.

Regards,
Tim.






Hari Prasadh[_2_]

A repost - Permuting SPACES within a String of words
 
Hi Tim,

Thnx a lot for your kind help. Will go through it. (Have been running in
circles till now)

Thanks a lot,
Hari
India

"Tim Williams" <saxifrax@pacbell*dot*net wrote in message
...
Hari,

For Regular Expressions see he
http://msdn.microsoft.com/library/de...xpressions.asp
http://www.mvps.org/dmcritchie/excel...sid.htm#RegExp

You could (instead of creating all possible permutations) use a regular
expression "pattern" which could be tested against you strings and match
regardless of the existence of spaces.

For your example of "ABC BCD EF GY" you might try something like:

Sub test()
TestMatch "I use ABC bcd EFGY in my job", "ABC\s*BCD\s*EF\s*GY"
End Sub



Sub TestMatch(sIn As String, sPatt As String)

Dim regex As Object, matches As Object, m As Object
Dim x As Integer

Set regex = CreateObject("vbscript.regexp")
regex.Pattern = sPatt
regex.Global = True
regex.ignorecase = True

Set matches = regex.Execute(sIn)
If matches.Count 0 Then
For x = 0 To matches.Count - 1
Debug.Print matches(x).Value
Next x
End If

End Sub


The pattern "ABC\s*BCD\s*EF\s*GY" will match any string containing "ABC"
folllowed by zero or more "space" characters, followed by "BCD" and then
zero or more space characters etc etc. Setting "ignorecase" to true will
also match instances where the case is not the same as your pattern.

I think this is going to prove useful to you once you have read some more
examples - the MS link has good documentation.

Good luck
Tim.








Tom Ogilvy

A repost - Permuting SPACES within a String of words
 
I know regular expressions are very powerful (and echo your encouragement),
but for your example which represents the OP's stated problem, a simple

Sub tester2()
sStr = "I use ABC bcd EFGY in my job"
sstr1 = "ABC bcd EF GY"

If InStr(1, Replace(sStr, " ", ""), _
Replace(sStr1," ",""), vbTextCompare) 0 Then
MsgBox "Match made"
Else
MsgBox "No Match"
End If

End Sub

would suffice.

--
Regards,
Tom Ogilvy



"Tim Williams" <saxifrax@pacbell*dot*net wrote in message
...
Hari,

For Regular Expressions see he

http://msdn.microsoft.com/library/de...xpressions.asp
http://www.mvps.org/dmcritchie/excel...sid.htm#RegExp

You could (instead of creating all possible permutations) use a
regular expression "pattern" which could be tested against you strings
and match regardless of the existence of spaces.

For your example of "ABC BCD EF GY" you might try something like:

Sub test()
TestMatch "I use ABC bcd EFGY in my job", "ABC\s*BCD\s*EF\s*GY"
End Sub



Sub TestMatch(sIn As String, sPatt As String)

Dim regex As Object, matches As Object, m As Object
Dim x As Integer

Set regex = CreateObject("vbscript.regexp")
regex.Pattern = sPatt
regex.Global = True
regex.ignorecase = True

Set matches = regex.Execute(sIn)
If matches.Count 0 Then
For x = 0 To matches.Count - 1
Debug.Print matches(x).Value
Next x
End If

End Sub


The pattern "ABC\s*BCD\s*EF\s*GY" will match any string containing
"ABC" folllowed by zero or more "space" characters, followed by "BCD"
and then zero or more space characters etc etc. Setting "ignorecase"
to true will also match instances where the case is not the same as
your pattern.

I think this is going to prove useful to you once you have read some
more examples - the MS link has good documentation.

Good luck
Tim.





"Hari Prasadh" wrote in message
...
Hi Tim,

Im sorry, dont understand what u mean by -- Regular expressions --
Is it an excel topic (Searched excel but couldnt find it) or is it a
mathematical topic. Please tell me.

As to what I was trying to do is compare text in column A with a
base list in column I. You have previously helped me in trying to
set up a base list in the column I. Now, as I have touched upon in
some other related posts, base list is something without TYPOS.
Also, base list would have the correct number of spaces between the
words. But column A would be having typos or would be having
inconsistent spaces (Please note these inconsistent spaces cannot be
handled by Trim function etc)

I am independently trying to handle the typo though its a problem
for the long-run (time-wise).

In the present post Im handling only Space problem. For ex.

If column A has -- NetBeans --- and Column I has -- Net Beans-- then
I would like to say that the Column A and Column I are *equivalent*.
As you would see a trim function wouldnt work here.
For that what am doing is to paste the base list in Column AF and
then run a macro called MakeMeMessy (which u have seen is quite
unweildy). This macro will take each cell in Column AF and then
permute the existence and non-existence of soaces between each word
in the string and output the result to column I. Once Im able to
generate all the permutations then I run a simple Vlookup to Map the
columns.

More demonstration.

***Before running the MakeMeMessy macro . FYI - ABC , BCD, EF, GY
are separate words just like Macromedia, cold, fusion are separate
words.

Column AF Column AG
Advanced Revelations 23
Macromedia Cold fusion 34
ABC BCD EF GY 45

** After running the Macro

Column I Column J
Advanced Revelations 23
AdvancedRevelations 23
Macromedia Cold fusion 34
Macromedia Coldfusion 34
MacromediaCold fusion 34
MacromediaColdfusion 34
ABC BCD EF GY 45
ABC BCD EFGY 45
ABC BCDEF GY 45
ABCBCD EF GY 45
ABCBCD EFGY 45
ABCBCDEF GY 45
ABC BCDEFGY 45
ABCBCDEFGY 45



Thanks a lot,
Hari
India

"Tim Williams" <saxifrax@pacbell*dot*net wrote in message
...
Hari,

I would not travel any further down this route: as you can see your
code will not scale beyond only a small number of words.

Perhaps you would get better suggestions if you could restate why
you need these permutations - there will no doubt be a
betterapproach to achieve what you want than trying to generate all
possible permutations up front. For example, you might be better
served reading a little on how Regular Expressions could help you
with your task. They are ideally suited to this kind of analysis
you seem to be doing.

Regards,
Tim.









All times are GMT +1. The time now is 07:21 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com