PDA

View Full Version : Solved: Moving cell values based on specific criteria



Beatrix
08-09-2012, 03:36 AM
Hi All ,

This below thread has been solved but I had a similar data scenario and replied to that instead of sending a new post. Because it seems solved that's why it didn't get any attention I'm afraid:(

Could anyone help me on this please??:help

http://www.vbaexpress.com/forum/showthread.php?t=43013

Cheers
Yeliz

CatDaddy
08-09-2012, 01:47 PM
Sub alex()
Dim cell As Range
Dim lr, lr2 As Long
ActiveWorkbook.Sheets(1).Activate
lr = Range("F" & Rows.Count).End(xlUp).Row
lr2 = Range("G" & Rows.Count).End(xlUp).Row
If lr2 > lr Then
lr = lr2
End If
For Each cell In Range("F1:F" & lr)
If cell.Value = "" And UCase(Right(cell.Offset(0, 1).Text, 4)) = "ROAD" Then
cell.Value = cell.Offset(0, 1).Text
cell.Offset(0, 1).ClearContents
End If
Next cell
End Sub

Beatrix
08-10-2012, 07:14 AM
Thanks very much for your response:cloud9: I've run the script but nothing changed. Would you mind to see references G33-37-40-62 (in split) in attachment?

PS: I've changed only Sheet object as Sheets(2) in below code, didn't touch rest of it.

Cheers
Yeliz


Sub alex()
Dim cell As Range
Dim lr, lr2 As Long
ActiveWorkbook.Sheets(1).Activate
lr = Range("F" & Rows.Count).End(xlUp).Row
lr2 = Range("G" & Rows.Count).End(xlUp).Row
If lr2 > lr Then
lr = lr2
End If
For Each cell In Range("F1:F" & lr)
If cell.Value = "" And UCase(Right(cell.Offset(0, 1).Text, 4)) = "ROAD" Then
cell.Value = cell.Offset(0, 1).Text
cell.Offset(0, 1).ClearContents
End If
Next cell
End Sub

Beatrix
08-10-2012, 07:16 AM
Sorry forgot the attachment in previous reply.

mancubus
08-10-2012, 04:26 PM
hi.

you have trailing spaces in cells. trim function will remove excess spaces from cells.

change

If cell.Value = "" And UCase(Right(cell.Offset(0, 1).Text, 4)) = "ROAD" Then

to

If cell.Value = "" And UCase(Right(Trim(cell.Offset(0, 1).Text), 4)) = "ROAD" Then

Beatrix
08-15-2012, 08:18 AM
That's brilliant!!:cloud9:

tHANKS VERy much mancubus as always :thumb

PS: sorry for the late reply.:bow:

Cheers
Yeliz




hi.

you have trailing spaces in cells. trim function will remove excess spaces from cells.

change

If cell.Value = "" And UCase(Right(cell.Offset(0, 1).Text, 4)) = "ROAD" Then
to

If cell.Value = "" And UCase(Right(Trim(cell.Offset(0, 1).Text), 4)) = "ROAD" Then

heysus jamal
08-15-2012, 12:27 PM
Nice, very useful!