If found more than x characters in a cell, copy row, insert below

[dado6612]

Hi all
Trying to do a bit of code where it would go thru the column and if it finds more than 7 spaces in a cell, it would copy that row and insert it under it
I've tried something like this but doesn't work
llr is last row

Range("e3", "e" & lllr).SelectFor Each c In Selection
c.Activate
if
ActiveCell.FormulaR1C1 = len(r3c5)-len(substitute(r3c5," "),""))
Case Is < 8
GoTo bla
Case Is > 7
ActiveCell.EntireRow.Copy
    Selection.Insert Shift:=xlDown
bla:
Next c

Bonus to this would be if possible to delete everything, including, after the 8th space, and in row under to remove everything, including, prior the 8th space

Ex, If it's a sentence like this in a cell then do this.

If it's a sentence like this in a
cell then do this.

Any help? Thanks

 

[Rick Rothstein]

in the cloud, it can be dropbox, then you put the link or send me an email to :

If you send it to the private email, then others (like me for instance) will not be able to see it. I would suggest you use DropBox.

 

[DanteAmor]

that was the first option
****** id="cke_pastebin" style="position: absolute; top: 0px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">that was the first option</body>

 

[dado6612]

https://wetransfer.com/downloads/a3...b64d0fa0d1b747a14c48f24f20181213181340/2660ee

 

[DanteAmor]

I think the explanation may be easier, I have this in the "master" sheet in cell "E2" and I want shown in the sheet "x" cell "F2"

 

[dado6612]

I think the explanation may be easier, I have this in the "master" sheet in cell "E2" and I want shown in the sheet "x" cell "F2"

Well I wish I can make it any easier and still get what I need.
Assign Column A from Master sheet to column D and list 8 first values to Column E
If more than 8, put them in next row until end of match (ex. CMC00377 starting in D12 takes 3 rows)
In column F put orders from Master sheet assigned to column D and column E and count how many times it's matched

Or like this:
From Master Sheet
Combine all numbers from column A and F assigned to same part from column E to column D (max 8 per row)
after all is run do the same but now columns A;H;I are combined

 

[Rick Rothstein]

https://wetransfer.com/downloads/a3...b64d0fa0d1b747a14c48f24f20181213181340/2660ee

We suggested DropBox because it is free and trusted (it has been well vetted)... not sure why you chose a website that we (well, at least I) have never heard of before. Sorry, but I will pass on downloading from there.

 

[dado6612]

We suggested DropBox because it is free and trusted (it has been well vetted)... not sure why you chose a website that we (well, at least I) have never heard of before. Sorry, but I will pass on downloading from there.

Edit: Yeah I did a second try, installing, update soon

 

[Rick Rothstein]

Dropbox asks me to register and give card details and subscription, which, for one single use, I'm not doing. I understand your concern. Thanks

You have to sign up, but you do not have to subscribe or pay money (which is why it was suggested to you) to DropBox to use it for posting a file. Go to the website (www.dropbox.com) and click the "For Individuals" link at the top of the page. Scroll down on the page you are taken to until you get to the "Choose the right Dropbox for you" section and click on the "Sign Up" button under in the box that starts with the text "Basic Free".

 

[dado6612]

https://www.dropbox.com/s/vd4co9doegi2l5p/Mrexcel.xlsm?dl=0
my apologies for that

 

[dado6612]

then try the following:

Sub found_more_than_x_characters()
    Application.ScreenUpdating = False
    Dim col As String, cad As String
    Dim lr As Double, fil As Double, cuenta As Integer
    Dim i As Double, j As Double, k As Double, coln As Double
    col = "E"                                   'column with numbers
    lr = Range(col & Rows.Count).End(xlUp).Row  'last row
    fil = 3                                     'initial row with numbers
    '
    coln = Columns(col).Column
    k = fil
    cuenta = 0
    For i = fil To lr
        numbers = Split(Cells(i, col).Value, " ")
        For j = LBound(numbers) To UBound(numbers)
            If cuenta > 7 Then
                Cells(k, coln + 1).Value = Mid(cad, 2)
                k = k + 1
                cad = ""
                cuenta = 0
            End If
            cad = cad & " " & numbers(j)
            cuenta = cuenta + 1
        Next
        If cad <> "" Then
            Cells(k, coln + 1).Value = Mid(cad, 2)
            k = k + 1
            cad = ""
            cuenta = 0
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub

Hi Dante, is it somehow possible to update lr after each "For" run? I've inserted copy cells and it works just fine until it reaches the old lr count, leaving last couple of rows unaffected. Thanks