copy & paste columns based on cell string length

[jelly77]

hello
I have a spreadsheet with various columns/rows of data. what I am trying to do is if a cell in column A has a string of less than 4 characters (this could be either alphanumerical or symbol) I need to cut & paste the values from columns G,D,E & F only to a new worksheet (in the same workbook) and shift only those columns up. for example in sheet1
A2=e/w then G2:F2 need to be cut & paste to sheet2 (starting A2) and cells G:F in sheet1 shifted up.

this would need to be run for all of column A

KR

 

[JLGWhiz]

Sub t()
Dim c As Range
With Sheets(1)
    For Each c In .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
        If c <> "" And Len(c) < 4 Then
            c.Offset(, 3).Resize(, 4).Cut Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
            Intersect(.Range("D:G"), .UsedRange).SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
        End If
    Next
End With
End Sub

 

[jelly77]

JLGWhiz, many thanks for this, it works a treat.

I do have one question I have a 2nd book that does the same thing, but this looks to column c but will need to cut/paste C:G, I assumed (stupidly) I could amend A2 to C2, D:G to C:G & the offset to 0, but it failed to work correctly. are you able to advise what did I do wrong

KR

 

[JLGWhiz]

For the second sheet

Sub t2()
Dim c As Range
With Sheets(1)
    For Each c In .Range("[COLOR=#b22222]C2[/COLOR]", .Cells(Rows.Count, 1).End(xlUp))
        If c <> "" And Len(c) < 4 Then
           [COLOR=#b22222] c.Resize(, 5).[/COLOR]Cut Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
            Intersect(.Range("[COLOR=#b22222]C:G[/COLOR]"), .UsedRange).SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
        End If
    Next
End With
End Sub

 

[jelly77]

thanks for the speedy response. This is deleting data in columns A & B also, this data should remain, apologies if I didn't explain that part only data in C:G should be cut/pasted.

again any advise would be great

KR

 

[JLGWhiz]

thanks for the speedy response. This is deleting data in columns A & B also, this data should remain, apologies if I didn't explain that part only data in C:G should be cut/pasted.

again any advise would be great

KR

Do you have formulas in columns A and B which are dependent on data in any of the cells in C:G?

Never mind I see the problem. Try this.

Sub t2()
Dim c As Range
With Sheets(1)
    For Each c In .Range("C2", .Cells(Rows.Count, [COLOR=#b22222]3[/COLOR]).End(xlUp))
        If c <> "" And Len(c) < 4 Then
            c.Resize(, 5).Cut Sheets(2).Cells(Rows.Count, 1).End(xlUp)(2)
            Intersect(.Range("C:G"), .UsedRange).SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
        End If
    Next
End With
End Sub

 

[jelly77]

that is magic.
can I be a pain once more. if there are rows in the lookup column with less than 4 characters it seems to miss them, I have looked for at loops but am unsure how/where this would be place in the code and also got confused with a reverse loop.

sorry to keep coming back with questions

KR

 

[JLGWhiz]

that is magic.
can I be a pain once more. if there are rows in the lookup column with less than 4 characters it seems to miss them, I have looked for at loops but am unsure how/where this would be place in the code and also got confused with a reverse loop.

sorry to keep coming back with questions

KR

I don't know what this means. the code does not use Lookup. If you mean Column C, I cannot duplicate the problem, it is finding all the ones that are less than 4 characters in my test set up. Be sure you do not have leading or trailing spaces in those cell that it skips. They count as characters also. Some people use spaces to delete typing errors instead of backspace or the delete key, and they leave those characters in the cells which the naked eye cannot detect.