Macro to cut numbers from cell, paste into adjacent cell to right, shift entire row if needed.

[JBExcel]

Two Terrible Scenarios (created by MRI Accounting Software output to Excel) occur I'm trying to fix:

Scenario 1: Cell Contains Words and Letters and needs to "cut" letters and paste into column next to it, shifting as needed and leaving words.

Before - A1: Net Rental Income 370,378

After - A1: Net Rental Income  A2: 370,378 (with other rows shifted right)

Scenario 2: Cell contains two numbers (delimiter is a space " ") and needs to be separated via cut and paste into cell to the right, shifting as needed and leaving left number where it is.

Before - A1: 18,825 17,525

After - A1: 18,825  A2: 1725 (with other columns shifted right)

Steps I've thought through:

1. Do this across the entire worksheet.
   
2. Search for cells containing an incorrectly shifted column of "Letters Numbers" or "Numbers Numbers"
   
3. Select 2nd portion using a split at the space.
   
4. Perform a cut, but leave behind the first portion of the cell (Letters or Numbers, depending on situation)
   
5. Paste into cell to the right of the one I'm on, shifting column right

I can do this for a formula to fix an entire column, but I'd like to be able to search via a macro and perform the steps to fix.

Thanks for any help my friends

 

[wigi]

Try...

Sub SplitTextAndNumbers()
    
    Dim r As Range
    
    For Each r In Selection.Cells
    
        v = InStrRev(r.Text, " ")
        r.Offset(, 1).Value = Val(Right(r.Text, Len(r.Text) - v))        
        r.Value = Left(r.Text, v - 1)
    
    Next

End Sub

... on a copy of the sheet! Cells will be overwritten.

First select the cells you want to rework, then run the macro.

 

[mikerickson]

How about this.
Double click on a cell:
A cell will be inserted to the right of the DoubleClicked Cell.
Everything after the last space in the DC cell is put in the new cell.
Everything preceding that remains in the original cell
You could put this in the Before_DoubleClick event.

Dim Words as Variant
Dim Size as Long

Words = Split(Application.Trim(CStr(Target.Value)), " ")
Size = UBound(Words)

If 0 < Size Then
    Target.Offset(0, 1).Insert shift:=xlRight
    Target.Offset(0,1).Value = Words(Size)
    ReDim Preserve Words(0 to (Size - 1))
    Target.Value = Join(Words, " ")
End If

For a bulk approach, is the presence of a space in the cell sufficient to show that the cells needs to be broken down?

 

[Scott Huish]

Sub test()
Dim c As Range, t
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    t = Split(c)
    c.Offset(, 1) = t(UBound(t))
    c = Trim(Left(c, Len(c) - Len(c.Offset(, 1)) - 1))
Next
End Sub

 

[JBExcel]

@mikerickson

Re: Bulk Approach, the cells are not always blank in the spot where the shift needs to occur.

@HOTPEPPER: It doesn't always occur in Column A. It only occurs in the rows starting with "Total"

Screenshot shows it better than I can explain.

The shift works correctly if we shift A and then shift the split. (See the total column)

This is part of a larger spreadsheet, not all rows have problems.

 

[Scott Huish]

OK, so put a check in. You didn't state this in your original problem.

Even your original samples didn't have the word Total in them.

 

[Scott Huish]

Sub test()
Dim c As Range, t
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    If Left(UCase(c), 5) = "TOTAL" Then
        t = Split(c)
        c.Offset(, 1) = t(UBound(t))
        c = Trim(Left(c, Len(c) - Len(c.Offset(, 1)) - 1))
    End If
Next
End Sub

 

[JBExcel]

Thank you HOTPEPPER!

My apologies, I didn't notice the "Total" until I consolidated the rows to upload the image.

I follow your code, and my instinct is to now use the Split function on the Scenario 2 problem, as it looks to be occurring on the same row as the Total as well, just 4 columns over.

Would this be how you approach it?

Sub test()
Dim c As Range, t
For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    If Left(UCase(c), 5) = "TOTAL" Then
        t = Split(c)
        c.Offset(, 1) = t(UBound(t))
        c = Trim(Left(c, Len(c) - Len(c.Offset(, 1)) - 1))
//Alter E column to be the left split of the E column
//Set F column equal to the right split (remaining text)
//Shift right    
End If
Next
End Sub