Home > Back-end >  Cut and paste text cells from one column to another
Cut and paste text cells from one column to another

Time:06-11

I'm essentially looking to move any cells with text from one of two columns across from column E/F to A. Keeping all other contents of the row the same. Have done and found examples with specific strings but nothing with just text. I think my issue maybe in the formatting of cell.value = IsText. Also not sure how to set the range to the last row in the column/sheet containing data. Other examples do entire sheet (even blanks) which can be slow at times.

Sub MoveJobFunctions()
    Dim row As Long

    For row = 2 To 1000
        'Check if is text
        If Range("E" & row).Value = IsText Then
            ' Copy the value and then blank the source.
            Range("A" & row).Value = Range("E" & row).Value
        End If
    Next
End Sub

CodePudding user response:

The code will read your IsText as an undeclared variable. Therefore the code will check if the value in column E is "equal to nothing". This code should do the trick:

Option Explicit
Sub MoveJobFunctions()
    Dim row As Long

    For row = 2 To 1000
        'Check if is text
        If Excel.WorksheetFunction.IsText(Range("E" & row).Value) Then
            ' Copy the value and then blank the source.
            Range("A" & row).Value = Range("E" & row).Value
            Range("E" & row).ClearContents
        End If
    Next
End Sub

As you can see, Excel.WorksheetFunction.IsText the proper way to use the IsText function. I've added the Option Explicit statement that will require you to declare any variable (or an error will occur). It will help you spot errors like the one that made your code uneffective. I've also added a line to clear the source value (as specified in your code's comment).

In order to cover only the list and not the whole sheet (or an hardcoded number of rows) you can use some trick like the ones in this link. A possible code (if there is nothing under the list) could be this one:

Option Explicit
Sub MoveJobFunctions()
    Dim row As Long
    Dim lastrow As Long
    
    lastrow = Range("E" & Cells.Rows.Count).End(xlUp).row
    
    For row = 2 To lastrow
        'Check if is text
        If Excel.WorksheetFunction.IsText(Range("E" & row).Value) Then
            ' Copy the value and then blank the source.
            Range("A" & row).Value = Range("E" & row).Value
            Range("E" & row).ClearContents
        End If
    Next
End Sub

In case the list is an uninterrupted series of data, you could use this code:

Option Explicit
Sub MoveJobFunctions()
    Dim row As Long
    Dim lastrow As Long
    
    lastrow = Range("E2").End(xlDown).row
    
    For row = 2 To lastrow
        'Check if is text
        If Excel.WorksheetFunction.IsText(Range("E" & row).Value) Then
            ' Copy the value and then blank the source.
            Range("A" & row).Value = Range("E" & row).Value
            Range("E" & row).ClearContents
        End If
    Next
End Sub

Or this one:

Option Explicit
Sub MoveJobFunctions()
    
    Dim cell As Range
    
    Set cell = Range("E2")
    
    Do Until cell.Value = ""
        'Check if is text
        If Excel.WorksheetFunction.IsText(cell.Value) Then
            ' Copy the value and then blank the source.
            Range("A" & cell.row).Value = cell.Value
            cell.ClearContents
        End If
        'Offsetting cell down to the next row.
        Set cell = cell.Offset(1, 0)
    Loop
End Sub
  • Related