Formula or VBA to Duplicate a Row based on the lenght of the value in cell

Hi moel79 ,

I'm sorry for the late response. I was a little busy during these last few days. I'm sending you this attached file with a code that may solve your problem. I also included a table with fake data, just to you check how it works (the cells with a bold THIS will have the row copied). 

I included some comments in the code to make it a little more understandable, but let me know if you need any additional explanation on that.

Also, make sure to do some changes to fit to your use case (like the minimum length for the text to be copied, for instance).

Here is the code:

Sub Duplicate_large_texts()

    Dim StringLength As Integer 'Variable to set the string lenght limit that you want to copy rows
    Dim CurRow As Integer ' Variable to store the current row that the program is reading
    Dim CurCol As Integer ' Variable to store the current col that the program is reading
    Dim EmptyCounter As Integer ' Variable to count the empty rows in a row
    Dim LastColumn As Integer ' Variable to store the last column that you want a row to be read
    Dim EmptyCol As Integer ' Variable to count the empty cells (by col) in a row.

    Sheets("Sheet1").Activate ' Change the name for the worksheet that you want to run the program
    StringLength = 30 ' Minimum lenght of the text to define if the row will be copied
    CurRow = 2 ' Row to start the program
    LastColumn = 10 ' Last column that you want a row to be read (in this case, col J)
    EmptyCounter = 0 ' Counter for empty rows in a row
    
    Do While EmptyCounter < 5 ' Run all rows until get 5 empty rows together (in a row)
        CurCol = 1 ' Start in the col A (1st one)
        EmptyCol = 0 ' Zero teh empty col counter for each new row
        Do While CurCol <= LastColumn ' Run all cols of the row
            If IsEmpty(Cells(CurRow, CurCol)) Then ' Increase the empty cell counter for the row
                EmptyCol = EmptyCol + 1
            Else
                EmptyCounter = 0 ' Zero the empty row counter in case of an ocupied cell
            End If
            
            If Len(Cells(CurRow, CurCol).Value) > StringLength Then ' If statement to get cells with a text larger than the min length
                Rows(CurRow + 1).Insert ' Insert a new row below
                Rows(CurRow).Copy Rows(CurRow + 1) 'Copy/paste the value to the new roc
                
                CurRow = CurRow + 1 ' Increment to skip the just added row
                Exit Do ' Jump to the next row, as this one is already copied
            Else
                CurCol = CurCol + 1 ' Go to next col, in case of this row is not copied
            End If
            
        Loop
        
        If EmptyCol = LastColumn Then ' If the entire row is empty, increase the empty counter
            EmptyCounter = EmptyCounter + 1
        End If
        
        CurRow = CurRow + 1
    
    Loop
    
    

End Sub