Need a code wizard to help with this one

I'm hoping someone can write the macro code to do the following to the attached file.

Step 1:  Remove any spaces AFTER the last character in column C
Step 2:  Take all characters after the first space in column A and put it after the last character in column C (with a space between the original character string in column C and the new text to be placed there

Row 7 shows exactly what I want the end result to be.  The original file is in the tab named "Before".  I'd like the end result to be in the tab named "After"

Can someone help?

--Steve
Test-File-To-Alter.xlsx
SteveL13Asked:
Who is Participating?
 
redmondbConnect With a Mentor Commented:
Hi, SteveL13.

Please see attached. A few points...
(1) The example shows spaces removed from BEFORE the original Col. C values, so that's what I did as well. A simple change to do AFTER, or BOTH.
(2) The example shows leading spaces removed from the extracted Col. A values, so that's what I did as well. Again, a simple change to undo this.
(3) The example shows the exctracted data dropped from the Col. A cells, so that's what I did. Again, an easy chase.
(4) The macro starts in Row 11. Is that correct?

The code is...
Option Explicit

Sub Concat()
Dim xLast_Row As Long
Dim xCell As Range

Sheets("Sheet1").Activate

xLast_Row = Range("A1").SpecialCells(xlLastCell).Row
If xLast_Row < 11 Then
    MsgBox ("No data found - run cancelled.")
    Exit Sub
End If

For Each xCell In Range("C11:C" & xLast_Row)
    xCell = LTrim(xCell) & IIf(xCell.Offset(0, -2) = "", "", " " & LTrim(Mid(xCell.Offset(0, -2), InStr(1, xCell.Offset(0, -2) & " ", " "), 9999)))
    If xCell.Offset(0, -2) <> "" Then
        xCell.Offset(0, -2) = RTrim(Mid(xCell.Offset(0, -2), 1, InStr(1, xCell.Offset(0, -2) & " ", " ") - 1))
    End If
Next

End Sub

Open in new window

Regards,
Brian.Test-File-To-Alter-V2.xlsm
0
 
Saqib Husain, SyedEngineerCommented:
Sub switchtext()
    Dim cel As Range
    For Each cel In Range("A11:A" & Range("A" & Rows.Count).End(xlUp).Row)
        cel.Offset(, 2) = WorksheetFunction.Trim(cel.Offset(, 2) & " " & Right(cel, Len(cel) - InStr(cel & " ", " ") + 1))
        cel.Value = Left(cel, InStr(cel & " ", " ") - 1)
    Next cel
End Sub
0
 
redmondbCommented:
SteveL13,

My first version update the cells in place, but in case you want it written to a new sheet...
Option Explicit

Sub Concat()
Dim xLast_Row As Long
Dim xCell As Range
Dim xSrce As Worksheet
Dim xDest As Worksheet
Dim xRow As Long

Set xSrce = Sheets("Sheet1")

xLast_Row = xSrce.Range("A1").SpecialCells(xlLastCell).Row
If xLast_Row < 11 Then
    MsgBox ("No data found - run cancelled.")
    Exit Sub
End If

Application.ScreenUpdating = False

Set xDest = Sheets.Add
xSrce.Range("A10:C10").Copy Destination:=xDest.Range("A1")
xRow = 1

For Each xCell In xSrce.Range("C11:C" & xLast_Row)
    xRow = xRow + 1
    
    xDest.Range("A" & xRow & ":" & "C" & xRow) = Array( _
        IIf(xCell.Offset(0, -2) = "", "", RTrim(Mid(xCell.Offset(0, -2), 1, InStr(1, xCell.Offset(0, -2) & "  ", " ") - 1))) _
        , xCell.Offset(0, -1) _
        , LTrim(xCell) & IIf(xCell.Offset(0, -2) = "", "", " " & LTrim(Mid(xCell.Offset(0, -2), InStr(1, xCell.Offset(0, -2) & " ", " "), 9999))))
Next

Application.ScreenUpdating = True

End Sub

Open in new window

Regards,
Brian.Test-File-To-Alter-V3.xlsm
0
 
SteveL13Author Commented:
Row 11 is the start, yes.

As far as I can tell what you did is perfect!  Thank you.
0
 
redmondbCommented:
Thanks, SteveL13!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.