Solved: Cut and Paste cell value between 2columns based on criteria

[Beatrix]

Hi Everyone ,

I need to Cut&Paste cell values from column D to C if the cell value doesn't start with number. Do you know the script to do that?

Cheers
Yeliz

[Trebor76]

Hi Yeliz T,

Try this, just bear in mind that it will overwrite an existing entry in column C if there's already a value in the cell:

Option Explicit
 
Sub Macro3()
 
    'http://www.vbaexpress.com/forum/showthread.php?t=43013
 
    Dim lngMyCol As Long, _
        lngMyRow As Long
 
    lngMyCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    lngMyRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    Application.ScreenUpdating = False
 
    With Columns(lngMyCol)
        With Range(Cells(1, lngMyCol), Cells(lngMyRow, lngMyCol))
            .Formula = "=IF(ISNUMBER(D1),D1,IF(LEN(C1)=0,"""",C1))"
            .Value = .Value
        End With
        .Cut Columns("C")
    End With
 
    Application.ScreenUpdating = True
 
End Sub

Regards,

Robert

[Beatrix]

Hi Trebor,

Thanks very much for your response. The code is working ok however it copies the numbers to other column. What I need to do is moving the cells into other column if cell value starts with a letter. Some cells have numbers only but some of them have number+text or text+number. If it starts with text I need to move whole cell content to the other column..Is that possible?

Cheers
Yeliz

Hi Yeliz T,

Try this, just bear in mind that it will overwrite an existing entry in column C if there's already a value in the cell:

Option Explicit
 
Sub Macro3()
 
    'http://www.vbaexpress.com/forum/showthread.php?t=43013
 
    Dim lngMyCol As Long, _
        lngMyRow As Long
 
    lngMyCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    lngMyRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    Application.ScreenUpdating = False
 
    With Columns(lngMyCol)
        With Range(Cells(1, lngMyCol), Cells(lngMyRow, lngMyCol))
            .Formula = "=IF(ISNUMBER(D1),D1,IF(LEN(C1)=0,"""",C1))"
            .Value = .Value
        End With
        .Cut Columns("C")
    End With
 
    Application.ScreenUpdating = True
 
End Sub

Regards,

Robert

[Trebor76]

OK, try this:

Option Explicit
 
Sub Macro1()
 
    'http://www.vbaexpress.com/forum/showthread.php?p=272750#post272750
 
    Dim lngEndRow As Long
    Dim rngCell As Range
 
    lngEndRow = Range("C:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    For Each rngCell In Range("D2:D" & lngEndRow) 'Assumes the data starts from Row 2. Change to suit.
        If IsNumeric(Left(rngCell, 1)) = False Then
            Range("C" & rngCell.Row) = rngCell
            rngCell.ClearContents
        End If
    Next rngCell
 
End Sub

Regards,

Robert

[Beatrix]

Hi Robert ,

This is so cool Thanks very much , appreciate for your time

Cheers
Yeliz

OK, try this:

Option Explicit
 
Sub Macro1()
 
    'http://www.vbaexpress.com/forum/showthread.php?p=272750#post272750
 
    Dim lngEndRow As Long
    Dim rngCell As Range
 
    lngEndRow = Range("C:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    For Each rngCell In Range("D2:D" & lngEndRow) 'Assumes the data starts from Row 2. Change to suit.
        If IsNumeric(Left(rngCell, 1)) = False Then
            Range("C" & rngCell.Row) = rngCell
            rngCell.ClearContents
        End If
    Next rngCell
 
End Sub

Regards,

Robert

[Trebor76]

Thanks for the feedback and I'm glad we were able to come up with a solution.

[Beatrix]

Hi Robert ,

I was wondering if it would be possible to edit below script to run similar data scenario like this:

If Column D&E blank and cell value is a number in column F and if the last 4 letters of the text is Road in column G then
the value in F moves to D and G goes to E.

Hope I didn't make it complicated

I don't exactly know what each line means in below script but I've thought they were similar scenarios moving the cell values based on criteria. If not I could go for a new thread ?

Cheers
Yeliz

OK, try this:

Option Explicit
 
Sub Macro1()
 
    'http://www.vbaexpress.com/forum/showthread.php?p=272750#post272750
 
    Dim lngEndRow As Long
    Dim rngCell As Range
 
    lngEndRow = Range("C:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    For Each rngCell In Range("D2:D" & lngEndRow) 'Assumes the data starts from Row 2. Change to suit.
        If IsNumeric(Left(rngCell, 1)) = False Then
            Range("C" & rngCell.Row) = rngCell
            rngCell.ClearContents
        End If
    Next rngCell
 
End Sub

Regards,

Robert

[Trebor76]

Hi Yeliz,

It's very hard to code something like this without seeing a before and after scenario of your data, but see how this goes:

Option Explicit
Sub Macro1()
 
    'http://www.vbaexpress.com/forum/showthread.php?p=272750#post272750
 
    Dim lngEndRow As Long
    Dim rngCell As Range
 
    lngEndRow = Range("C:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    For Each rngCell In Range("D2:D" & lngEndRow) 'Assumes the data starts from Row 2. Change to suit.
        If IsNumeric(Left(rngCell, 1)) = False And _
           Len(rngCell) > 0 Then
            Range("C" & rngCell.Row) = rngCell
            rngCell.ClearContents
        ElseIf Len(Range("D" & rngCell.Row)) + Len(Range("E" & rngCell.Row)) = 0 And _
               IsNumeric(Range("F" & rngCell.Row)) = True And _
               StrConv(Right(Range("G" & rngCell.Row), 4), vbProperCase) = "Road" Then
            rngCell = Range("F" & rngCell.Row)
            Range("F" & rngCell.Row).ClearContents
            Range("E" & rngCell.Row) = Range("G" & rngCell.Row)
            Range("G" & rngCell.Row).ClearContents
        End If
    Next rngCell
 
End Sub

Regards,

Robert

[Beatrix]

Robert Robert Robert

I've just run the script it's working yayyyy this is so cool, I'm dying to be able to write something like this one day..currently doing the online course..need to work hard..

you made my day..thanks very much again..it's just a part of complicated task I've been working for a long time that's why I'm sooo happy

Cheersssss
Yeliz

Hi Yeliz,

It's very hard to code something like this without seeing a before and after scenario of your data, but see how this goes:

Option Explicit
Sub Macro1()
 
    'http://www.vbaexpress.com/forum/showthread.php?p=272750#post272750
 
    Dim lngEndRow As Long
    Dim rngCell As Range
 
    lngEndRow = Range("C:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
    For Each rngCell In Range("D2:D" & lngEndRow) 'Assumes the data starts from Row 2. Change to suit.
        If IsNumeric(Left(rngCell, 1)) = False And _
           Len(rngCell) > 0 Then
            Range("C" & rngCell.Row) = rngCell
            rngCell.ClearContents
        ElseIf Len(Range("D" & rngCell.Row)) + Len(Range("E" & rngCell.Row)) = 0 And _
               IsNumeric(Range("F" & rngCell.Row)) = True And _
               StrConv(Right(Range("G" & rngCell.Row), 4), vbProperCase) = "Road" Then
            rngCell = Range("F" & rngCell.Row)
            Range("F" & rngCell.Row).ClearContents
            Range("E" & rngCell.Row) = Range("G" & rngCell.Row)
            Range("G" & rngCell.Row).ClearContents
        End If
    Next rngCell
 
End Sub

Regards,

Robert

[Trebor76]

Thanks again for your kind feedback

[Beatrix]

Hi Everyone ,

I need to move cell values from column G to F if column F is blank and the last 4 characters in column G is Road.

Robert (Trebor76) helped me with similar data scenario. (please see below posts) I tried to edit the script he wrote for me. I deleted some lines and updated cell references but failed After I spent considerable time on trying, I decided to ask you guys.. Could anyone help me on this please??

[VBA]Sub SplittingRoad2()
'http://www.vbaexpress.com/forum/showthread.php?p=272750#post272750

Dim lngEndRow As Long
Dim rngCell As Range

lngEndRow = Range("F:G").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For Each rngCell In Range("F2:F" & lngEndRow) 'Assumes the data starts from Row 2. Change to suit.
If Len(Range("F" & rngCell.Row)) = 0 And _
StrConv(Right(Range("G" & rngCell.Row), 4), vbProperCase) = "Road" Then
Range("F" & rngCell.Row) = Range("G" & rngCell.Row)

End If
Next rngCell

End Sub
[/VBA]

Cheers
Yeliz