vba help

[dasfadsf]

hi, hope someone can help?

I have 4 columns :A,B,C,D

If A is more than 10 chars i want it copied to B and deleted from A
If C has more than 10 chars, i want it copied to D and deleted from C

If B or D aready have chars, and the contents of A or C are moving to them, i need the contents of A or B to go after the contents of C or D

I need a script as there are thousands of records and i need it to do it to every row

Thanks for the help!

before
Column A	Column B	Column C	Column D
supermarket	Sunday	jackhammers	Blue

after
Column A	Column B	Column C	Column D
	Sunday, Supermarket		Blue, jackhammers

[Paul_Hossler]

Something like this probably

In the attachment, 'testing' is the result with data that looked like 'Starting' sheet

Option Explicit

'If A is more than 10 chars i want it copied to B and deleted from A
'If C has more than 10 chars, i want it copied to D and deleted from C
'If B or D aready have chars, and the contents of A or C are moving to them,
'   i need the contents of A or B to go after the contents of C or D

Sub MoveData()
    Dim iLastRow As Long, i As Long
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        iLastRow = .Cells(1, 1).CurrentRegion.Rows.Count
    
        For i = 1 To iLastRow       ' assumes not header row
            If Len(.Cells(i, 1).Value) > 10 Then
                If Len(.Cells(i, 2).Value) = 0 Then
                    .Cells(i, 2).Value = .Cells(i, 1).Value
                Else
                    .Cells(i, 2).Value = .Cells(i, 2).Value & "," & .Cells(i, 1).Value
                End If
                
                .Cells(i, 1).ClearContents
            
            End If
            
            If Len(.Cells(i, 3).Value) > 10 Then
                If Len(.Cells(i, 4).Value) = 0 Then
                    .Cells(i, 4).Value = .Cells(i, 3).Value
                Else
                    .Cells(i, 4).Value = .Cells(i, 4).Value & ", " & .Cells(i, 3).Value
                End If
                
                .Cells(i, 3).ClearContents
            
            End If
        Next I
        
    End With
    
    Application.ScreenUpdating = True

End Sub