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

 

[mumps]

Assuming your sentence is in cell A1, try:

Sub satish()
    Application.ScreenUpdating = False
    Dim splitRng As Variant, i As Long, val As String, fWord As String, lWord As String
    splitRng = Split(Range("A1"), " ")
    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
    Range("A1") = fWord & " " & val & " " & lWord
    Application.ScreenUpdating = True
End Sub

 

[satish78]

Assuming your sentence is in cell A1, try:

Sub satish()
    Application.ScreenUpdating = False
    Dim splitRng As Variant, i As Long, val As String, fWord As String, lWord As String
    splitRng = Split(Range("A1"), " ")
    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
    Range("A1") = fWord & " " & val & " " & lWord
    Application.ScreenUpdating = True
End Sub

It only changes in A1 row1 not in all rows

 

[mumps]

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

 

[satish78]

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

Here what I am getting

Below is actual data

Defining driving software architecture enterprise capabilities scalability fault tolerance extensibility maintainability

Determining overall architectural principles frameworks standards

Creating well thought out architecture strategy manage alignment product roadmaps

Partnering business stakeholders technology leaders translate program requirements technical solutions system design

Driving research case studies prototypes leading edge technologies leveraged

Providing hands-on development appropriate

Designing proof-of-concept pilots working closely technical leads drive successful POC implementations

VBA Result

driving software-software architecture-architecture enterprise-enterprise capabilities-capabilities scalability-scalability fault-fault tolerance-tolerance extensibility-extensibility maintainability-maintainability

overall software-software architecture-architecture enterprise-enterprise capabilities-capabilities scalability-scalability fault-fault tolerance-tolerance extensibility-extensibility maintainability-maintainability architectural-architectural principles-principles frameworks-frameworks standards

well software-software architecture-architecture enterprise-enterprise capabilities-capabilities scalability-scalability fault-fault tolerance-tolerance extensibility-extensibility maintainability-maintainability architectural-architectural principles-principles frameworks-frameworks thought-thought out-out architecture-architecture strategy-strategy manage-manage alignment-alignment product-product roadmaps

business software-software architecture-architecture enterprise-enterprise capabilities-capabilities scalability-scalability fault-fault tolerance-tolerance extensibility-extensibility maintainability-maintainability architectural-architectural principles-principles frameworks-frameworks thought-thought out-out architecture-architecture strategy-strategy manage-manage alignment-alignment product-product stakeholders-stakeholders technology-technology leaders-leaders translate-translate program-program requirements-requirements technical-technical solutions-solutions system-system design

research software-software architecture-architecture enterprise-enterprise capabilities-capabilities scalability-scalability fault-fault tolerance-tolerance extensibility-extensibility maintainability-maintainability architectural-architectural principles-principles frameworks-frameworks thought-thought out-out architecture-architecture strategy-strategy manage-manage alignment-alignment product-product stakeholders-stakeholders technology-technology leaders-leaders translate-translate program-program requirements-requirements technical-technical solutions-solutions system-system case-case studies-studies prototypes-prototypes leading-leading edge-edge technologies-technologies leveraged

hands-on software-software architecture-architecture enterprise-enterprise capabilities-capabilities scalability-scalability fault-fault tolerance-tolerance extensibility-extensibility maintainability-maintainability architectural-architectural principles-principles frameworks-frameworks thought-thought out-out architecture-architecture strategy-strategy manage-manage alignment-alignment product-product stakeholders-stakeholders technology-technology leaders-leaders translate-translate program-program requirements-requirements technical-technical solutions-solutions system-system case-case studies-studies prototypes-prototypes leading-leading edge-edge technologies-technologies development-development appropriate

proof-of-concept software-software architecture-architecture enterprise-enterprise capabilities-capabilities scalability-scalability fault-fault tolerance-tolerance extensibility-extensibility maintainability-maintainability architectural-architectural principles-principles frameworks-frameworks thought-thought out-out architecture-architecture strategy-strategy manage-manage alignment-alignment product-product stakeholders-stakeholders technology-technology leaders-leaders translate-translate program-program requirements-requirements technical-technical solutions-solutions system-system case-case studies-studies prototypes-prototypes leading-leading edge-edge technologies-technologies development-development pilots-pilots working-working closely-closely technical-technical leads-leads drive-drive successful-successful POC-POC implementations

 

[Fluff]

Try this tweak to mumps' code

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(0)
        lWord = splitRng(UBound(splitRng))
        For i = 1 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
        val = ""
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[satish78]

Try this tweak to mumps' code

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(0)
        lWord = splitRng(UBound(splitRng))
        For i = 1 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
        val = ""
    Next rng
    Application.ScreenUpdating = True
End Sub

Mumps and Fluff, Thanks for your both efforts.
Fluff. It worked like charm.

Thanks again both of you.

Satish

 

[Fluff]

@mumps deserves all the credit, I just tweaked his code.

 

[dcardno]

I tried to implement this as a function:

Option Explicit

Function DblWord(stInput) As String

Dim stOut As String
Dim arWords() As Variant
Dim i As Long

arWords = Split(stInput)   'this is where it reports a type mismatch

stOut = arWords(0)
For i = 1 To UBound(arWords, 1) - 1
    stOut = stOut & " " & arWords(i) & "-" & arWords(i)
Next i
stOut = stOut & " " & arWords(i + 1)

DblWord = stOut


End Function

The function returns a #VALUE! error, and when I track it by calling it from another procedure and stepping through, it reports a type mismatch on the line that assigns the arWords array to the Split function output. This seems to happen no matter how I present the string - either as an input itself, or even following the syntax in Microsoft's example of the Split function, and creating a static string within the function and then applying the Split function to it. Anyone have any ideas, or run into anything similar?

 

[Fluff]

You need to remove the brackets where you declare arWords, you will also need to change the pen line to arWords(i) otherwise you'll go out of bounds .