Copy 10 digits in a numbers and paste to another column

I have attached the macro file, the only thing i am missing is when i copy the first 10 digit and paste it in column W then it will copy again the 2nd 10 digits and when copying the 2nd row data it won't copy it anymore because it will not do the loop because its blank or when trying to change it i will skip or will just continue to loop

Does this help?

Sub ash3angelz()
Dim x As Long, y As Long, z As Long, i As Long, w
ReDim w(2 To Range("X" & Rows.Count).End(3).row)
For i = LBound(w) To UBound(w)
x = Len(Cells(i, "X"))
Select Case x
Case Is = 10
Range("W" & Rows.Count).End(3)(2) = Left(Cells(i, "X"), x)
Case Is > 10
Cells(i, "X").Select
y = x / 10
z = 0
Do Until y = 0
Range("W" & Rows.Count).End(3)(2) = Left(Right(ActiveCell, Len(ActiveCell) - z), 10)
z = z + 10
y = y - 1
Loop
End Select
Next i
End Sub

In Column w:

=LEFT(TEXT(X1,"0"),10)

Hi John,

It's not copying the data in Column X

When I tested it on your sample, it copied it? Also, I admit some of your data is off. Although I assumed that each cell could be divided evenly by ten, when I run a Len(cell) for the X Column I'm getting some cells with an extra character (ie 21, 32 ect.). This throws the macro off. However, when you do a visual character count I get (20, 30 ect.)

Opps my fault, i copied the code in wrong sheets.

Its perfect the only thing left is which i forgot to quote the finish product should looks like this

column V column w

1 10 digits
10 digits
2 10 digits
3 10 digits
4 10 digits
10 digits

for every 10 digits in a row should be across in column v

Can you provide a sample with how it would look before and after?

Capture.PNG


the outcome should looks like

Try:

Sub ash3angelz()
Dim x As Long, y As Long, z As Long, i As Long, w
ReDim w(2 To Range("X" & Rows.Count).End(3).row)
For i = LBound(w) To UBound(w)
x = Len(Cells(i, "X"))
Select Case x
Case Is = 10
Range("W" & Rows.Count).End(3)(2) = Left(Cells(i, "X"), x)
Case Is = 21
Range("W" & Rows.Count).End(3)(2) = Left(Cells(i, "X"), 10)
Range("W" & Rows.Count).End(3)(2) = Right(Cells(i, "X"), 10)
Case Is = 32
Range("W" & Rows.Count).End(3)(2) = Left(Cells(i, "X"), 10)
Range("W" & Rows.Count).End(3)(2) = Left(Right(Cells(i, "X"), 22), 11)
Range("W" & Rows.Count).End(3)(2) = Right(Cells(i, "X"), 10)
End Select
Next i
End Sub

its good, however i need to have space for every invoice

sample - lets pretend the 1 digit is equal to 10

starting row should remain and only leave space for every 10 digit numbers or copy to the next same with 2nd starting row first 10 digit across the 2nd starting row then it will insert a row then paste the other 10 digits

invoice 1 - 1
_________2
invoice 2 - 1
invoice 3 - 1
________2
________3
invoice4 1
_________2

Not sure I follow you? That's the reason for the result sheet.

Sub ash3angelz()
Dim x As Long, y As Long, z As Long, i As Long, w
ReDim w(2 To Range("X" & Rows.Count).End(3).row)
For i = LBound(w) To UBound(w)
x = Len(Cells(i, "X"))
Select Case x
Case Is = 10
Range("W" & Rows.Count).End(3)(3) = Left(Cells(i, "X"), x)
Case Is = 21
Range("W" & Rows.Count).End(3)(3) = Left(Cells(i, "X"), 10)
Range("W" & Rows.Count).End(3)(3) = Right(Cells(i, "X"), 10)
Case Is = 32
Range("W" & Rows.Count).End(3)(3) = Left(Cells(i, "X"), 10)
Range("W" & Rows.Count).End(3)(3) = Left(Right(Cells(i, "X"), 22), 11)
Range("W" & Rows.Count).End(3)(3) = Right(Cells(i, "X"), 10)
End Select
Next i
End Sub

I have attached the result and raw - hope this will help

THanks

This places the results from Columns "D" and "E" into "A" and "B". Per your sample Results.

Sub ash3angelz()
Dim x As Long, y As Long, z As Long, i As Long, w
ReDim w(2 To Range("E" & Rows.Count).End(3).row)
For i = LBound(w) To UBound(w)
x = Len(Cells(i, "E"))
Select Case x
Case Is = 10
Range("B" & Rows.Count).End(3)(2) = Left(Cells(i, "E"), x)
Range("A" & Rows.Count).End(3)(2) = Cells(i, "D")
Case Is = 21
Range("A" & Rows.Count).End(3)(2) = Cells(i, "D")
Range("B" & Rows.Count).End(3)(2) = Left(Cells(i, "E"), 10)
Range("B" & Rows.Count).End(3)(2) = Right(Cells(i, "E"), 10)
Range("A" & Rows.Count).End(3)(2) = " "
Case Is = 32
Range("A" & Rows.Count).End(3)(2) = Cells(i, "D")
Range("B" & Rows.Count).End(3)(2) = Left(Cells(i, "E"), 10)
Range("A" & Rows.Count).End(3)(2) = " "
Range("B" & Rows.Count).End(3)(2) = Left(Right(Cells(i, "E"), 22), 11)
Range("A" & Rows.Count).End(3)(2) = " "
Range("B" & Rows.Count).End(3)(2) = Right(Cells(i, "E"), 10)
Range("A" & Rows.Count).End(3)(2) = " "
End Select
Next i
End Sub

Try

Sub test()
    Dim a, b, i As Long, n As Long, m As Object
    With Range("x2", Range("x" & Rows.Count).End(xlUp))
        a = .Value
        ReDim b(1 To 1000, 1 To 1)
        With CreateObject("VBScript.RegExp")
            .Global = True
            .Pattern = "\d{10}"
            For i = 1 To UBound(a, 1)
                For Each m In .Execute(a(i, 1))
                    n = n + 1: b(n, 1) = m
            Next m, i
        End With
        .Columns(0).Resize(n).Value = b
    End With
End Sub