PDA

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



Beatrix
07-18-2012, 07:47 AM
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
07-18-2012, 09:55 PM
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
07-19-2012, 05:32 AM
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
07-19-2012, 04:39 PM
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
07-20-2012, 04:51 AM
Hi Robert ,

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

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
07-20-2012, 05:13 AM
Thanks for the feedback and I'm glad we were able to come up with a solution.

Beatrix
07-24-2012, 09:37 AM
Hi Robert ,

:think: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: pray2:

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
07-24-2012, 05:47 PM
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
07-25-2012, 09:24 AM
Robert Robert Robert :cloud9:

I've just run the script it's working:thumb 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:bow:

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
07-25-2012, 03:21 PM
Thanks again for your kind feedback ;)

Beatrix
08-08-2012, 06:50 AM
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:doh: After I spent considerable time on trying, I decided to ask you guys.. Could anyone help me on this please??

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


Cheers
Yeliz