How to convert or copy every 2 words using VBA

[satish78]

Hi Friends,

I am trying to copy words like shown below for example.
Want to do with excel vba.

This is actual sentence: Defining driving software architecture enterprise capabilities scalability fault tolerance extensibility maintainability

I want to convert it to this: defining driving-driving software-software architecture-architecture capabilities-capabilities scalability-scalability fault-fault tolerance-tolerance extensibility-extensibility maintainability

Let me know if you have any questions.

Thanks
Satish

 

[dcardno]

Thanks Fluff - works perfectly. The MS example for the "Split" function includes the brackets in the variable declaration, but I can't argue with results! I thought "i" would stop incrementing at Ubound(arWords) - 1 - obviously not!

 

[Fluff]

The "Next i" adds 1 to i until it goes out of bounds for the loop, so i will always be 1 more than the max number for the loop (assuming step 1).

 

[dcardno]

Right... and I thought I was being so clever

 

[tiredtea]

Try:

Sub satish()
    Application.ScreenUpdating = False
    Dim rng As Range, splitRng As Variant, i As Long, val As String, fWord As String, lWord As String
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In Range("A1:A" & LastRow)
        splitRng = Split(rng, " ")
        fWord = splitRng(1)
        lWord = splitRng(UBound(splitRng))
        For i = 2 To UBound(splitRng) - 1
            If val = "" Then val = splitRng(i) & "-" & splitRng(i) & " " Else val = val & splitRng(i) & "-" & splitRng(i) & " "
        Next i
        rng = fWord & " " & val & " " & lWord
    Next rng
    Application.ScreenUpdating = True
End Sub

I'm

Try:

Sub satish()
    Application.ScreenUpdating = False
    Dim rng As Range, splitRng As Variant, i As Long, val As String, fWord As String, lWord As String
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In Range("A1:A" & LastRow)
        splitRng = Split(rng, " ")
        fWord = splitRng(1)
        lWord = splitRng(UBound(splitRng))
        For i = 2 To UBound(splitRng) - 1
            If val = "" Then val = splitRng(i) & "-" & splitRng(i) & " " Else val = val & splitRng(i) & "-" & splitRng(i) & " "
        Next i
        rng = fWord & " " & val & " " & lWord
    Next rng
    Application.ScreenUpdating = True
End Sub

Sorry guys, first time on a thread and I don't think I'm doing this right but I just wanted to say: @mumps - I've been struggling all day on a code and when I was finally about to give up, I found a lot of your comments to be helpful and push me forward. Still nowhere near figuring it out but thank you for the motivation!

 

[Rick Rothstein]

Does this code do what is being asked for...

Sub DoubledWords()
  Dim R As Long, X As Long, Text As String, Arr As Variant, Words As Variant
  Arr = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  For R = 1 To UBound(Arr)
    Text = ""
    Words = Split(Arr(R, 1))
    For X = 0 To UBound(Words) - 1
      Text = Text & "-" & Words(X) & " " & Words(X + 1)
    Next
    Arr(R, 1) = Mid(Text, 2)
  Next
  Range("B1").Resize(UBound(Arr)) = Arr
End Sub

 

[Peter_SSs]

Another approach without looping in each 'sentence', doing all the doubling-up in a cell at once.

Sub DoubleEmUp()
  Dim RX As Object
  Dim a As Variant
  Dim i As Long
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "( )(.+?)(?= )"
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    a(i, 1) = RX.Replace(a(i, 1), "$1$2-$2")
  Next i
  Range("B1").Resize(UBound(a)).Value = a
End Sub

My sample data and results:

satish78 2020-05-08 1.xlsm
	A	B
1	Defining driving software architecture enterprise capabilities scalability fault tolerance extensibility maintainability	Defining driving-driving software-software architecture-architecture enterprise-enterprise capabilities-capabilities scalability-scalability fault-fault tolerance-tolerance extensibility-extensibility maintainability
2	Determining overall architectural principles frameworks standards	Determining overall-overall architectural-architectural principles-principles frameworks-frameworks standards
3	Creating well thought out architecture strategy manage alignment product roadmaps	Creating well-well thought-thought out-out architecture-architecture strategy-strategy manage-manage alignment-alignment product-product roadmaps
4	Partnering business stakeholders technology leaders translate program requirements technical solutions system design	Partnering business-business stakeholders-stakeholders technology-technology leaders-leaders translate-translate program-program requirements-requirements technical-technical solutions-solutions system-system design
5	Driving research case studies prototypes leading edge technologies leveraged	Driving research-research case-case studies-studies prototypes-prototypes leading-leading edge-edge technologies-technologies leveraged
6	Providing hands-on development appropriate	Providing hands-on-hands-on development-development appropriate
7	Designing proof-of-concept pilots working closely technical leads drive successful POC implementations	Designing proof-of-concept-proof-of-concept pilots-pilots working-working closely-closely technical-technical leads-leads drive-drive successful-successful POC-POC implementations
Sheet1