View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
saman110 via OfficeKB.com saman110 via OfficeKB.com is offline
external usenet poster
 
Posts: 80
Default Move cells according to value

Can anybody help? please

saman110 wrote:
Hello All,

I have this macro, what is does is it keeps in the column directionals like S,
W, N, E and moves the rest to the next column. What is want is opposite keep
everything and move the directional to the next column. Any help?

Sub Move_Value()
Dim rngB As Range
Dim cel As Range
Dim strToFind As String
Dim strValid As String

'String to have both leading and trailing commas for each value
strValid = ",N,S,W,E,NE,NW,SW,SE,WN,WS,ES,EN,"

'NOTE:Cells(2, "B") starts row 2.
'To start row 1 change to Cells(1, "B")
With Sheets("Sheet1") 'Edit sheet name if required
Set rngB = Range(Cells(2, "B"), _
Cells(Rows.Count, "B").End(xlUp))
rngB.Select
End With

For Each cel In rngB
'Create string from cell value with
'leading and trailing commas
strToFind = "," & cel.Value & ","

'Test for existance of string
'If following line returns Zero then not found.
If InStr(1, strValid, strToFind) = 0 Then
'Not found therefore copy to column C
cel.Offset(0, 1) = cel.Value
'Clear value from column B
cel.ClearContents
End If
Next cel

End Sub

Thx.


--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...excel/200711/1