find move a row up to order

[sparcle]

Hi,

[pre]

A         B          C           D
1
2
3
4
5
6

[/pre]
Column A is simple serial nos.


I am wondering there is any way that if i randomly select any no of cells ( i.e. 1-4 or 1-6 or 1-3 ) & then run a macro then a single cell move upwards with minimum row value of column A ( i.e if i select row 1-5 then move to row 1, if i select row 3-6 then it move to row 3)

rows move upwards obeying these conditions,

they are

1) if row B value is true then move upward.(take values as cell color )

2)if there are multiple B value true then if there is C value is true then it move upwards.


3)if there is no B value true & there is C value true then it move upwards.


4)if no B & C values true then rows remain same as their A values i.e. serial nos.

 

[Luke M]

Could you expand your example to show columns B and C, and include a before & after look? I'm having trouble understanding how your different conditions work.

 

[sparcle]

hi, Luke

here is my example before & after look.

[pre]

EX-1
------
A         B          C           D
1         NO         NO
2         NO         YES
3         NO         YES
4         NO         NO

AFTER
------
A         B          C           D
2         NO         YES
1         NO         NO
3         NO         YES
4         NO         NO

EX-2
----
A         B          C           D
1         NO         NO
2         NO         YES
3         YES        YES
4         NO         NO

AFTER
-----
A         B          C           D
3         YES        YES
1         NO         NO
2         NO         YES
4         NO         NO

EX-3
-----
A         B          C           D
1         NO         NO
2         NO         NO
3         NO         NO
4         YES        NO

AFTER
------
A         B          C           D
4         YES        NO
1         NO         NO
2         NO         NO
3         NO         NO

[/pre]

 

[Luke M]

I believe this will do what you ask.

[pre]

Sub ReorderRows()
Dim xSelect As Range
Dim BRange As Range
Dim CRange As Range
Dim c As Range
Dim firstAddress As String

Set xSelect = Selection.EntireRow

Set BRange = Intersect(xSelect, Range("B:B"))
Set CRange = Intersect(xSelect, Range("C:C"))

If WorksheetFunction.CountIf(Union(BRange, CRange), "YES") = 0 Then
'Do nothing
Exit Sub
ElseIf WorksheetFunction.CountIf(BRange, "YES") = 1 Then
'only 1 YES found
BRange.Find("YES").EntireRow.Cut
ElseIf WorksheetFunction.CountIf(BRange, "YES") > 1 Then
'multiple YES found in col B

With BRange
Set c = .Find("YES")
firstAddress = c.Address
'Check for corresponding C value
If c.Offset(0, 1) <> "YES" Then
Do
Set c = .FindNext
Loop Until c.Offset(0, 1) = "YES" Or c.Address = firstAddress
End If
End With
c.EntireRow.Cut
Else
'YES only found in col C
CRange.Find("YES").EntireRow.Cut
End If
xSelect.Cells(1, 1).Insert Shift:=xlDown
End Sub

[/pre]

 

[sparcle]

@Luke,


that work fine by inter changing rows condition B & C.


sir, one thing i must say, Excel Ninja Tag does not come with an ease.

you truly deserve that.I wonder how ease you do that which takes all my efforts,

thanks for your help & appreciate your work.


if need any further help, may be i give you some trouble again.

 

[Montrey]

The guy is a god. no one believes me.

 

[sparcle]

@montrey


sorry i can't get you.

About who you talking about.

 

[Montrey]

Luke

 

[bobhc]

Montery is referring to Luke M.....he could have been closer to the Nijas but Diablo 3 has a very strange affect on him

 

[sparcle]

Luke, Definitely he is one.


@bobhc

I have no idea that here also i can find game follower.

 

[bobhc]

Montery is not so much a game follower, he lives, eats and sleeps it, when the latest release came out he disappeared from the forum for awhile

 

[Luke M]

Thanks for the kind words everyone. As for games, of course we game. Got to have some fun while we work. Battlefield 3 is my current choice, followed by Halo. Montrey dedicated a whole post to when Diablo 3 came out:

http://chandoo.org/forums/topic/diablo-3-tomorrow


I've seen other posters interested in Need for Speed - The Run, Skyrim, and Fallout. Feel free to post in The Lounge:

http://chandoo.org/forums/forum/the-lounge

to talk games. =)

 

[Montrey]

<3 my friends.

 

[SirJB7]

@all

Hi!

My satellite sources told me that someone said "Need for speed"... Is there anybody sending invitations for a party? I'm in!

Regards!


@sparcle

Hi!

BTW, computers main usage should be making human life easier and healthy, so I still don't understand why people don't use them primarily for gaming... most people indredibly insist about programming, databases, Excel, ...



Regards!

 

[sparcle]

@SirJB7


your wording is true, also fan of games but now few months away from game due to eye prob


Love to play in any platform from old console to android, give me one the party is on.

 

[sparcle]

Hi Luke,

in this example if D column has time value & i select a random row then

instead of this


Set xSelect = Selection.EntireRow


i want to select those rows which have less time value than selected row.

 

[Luke M]

Are the times in random amounts? Are they just time stamps, or do they include days as well?

 

[sparcle]

@Luke


they are just like 17-May-12 08:00


so,rows selected are before 17-May-12 08:00 .


explaining more


if i select a row has & its D column value 17-May-12 08:00 then rows automatic selected in a worksheet are cells before 17-May-12 08:00.

 

[Luke M]

Any chance your table has an AutoFilter on it? Might be able to get this to work by filtering the data...

 

[sparcle]

hi Luke


is there any way to filter it, you solve my problem above.

 

[Luke M]

Assuming the AutoFilter is not already on, this should do it:

[pre]

Sub ReorderRows()
Dim xSelect As Range
Dim BRange As Range
Dim CRange As Range
Dim c As Range
Dim firstAddress As String
Dim TimeStamp As Double
Dim DTable As Range
Dim CutRow As Range

TimeStamp = Cells(ActiveCell.Row, "D").Value
Set DTable = Selection.CurrentRegion

'Delete this line if AutoFilter is already active
DTable.AutoFilter

'Filter down to just the relevant info
ActiveSheet.Range("A1").AutoFilter Field:=4, Criteria1:= _
"<=" & TimeStamp

'Old line
'Set xSelect = Selection.EntireRow

'New Line
Set xSelect = DTable.Offset(1, 0).Resize(DTable.Rows.Count - 1, _
DTable.Columns.Count).SpecialCells(xlCellTypeVisible).EntireRow

Set BRange = Intersect(xSelect, Range("B:B"))
Set CRange = Intersect(xSelect, Range("C:C"))

If WorksheetFunction.CountIf(Union(BRange, CRange), "YES") = 0 Then
'Do nothing
Exit Sub
ElseIf WorksheetFunction.CountIf(BRange, "YES") = 1 Then
'only 1 YES found
Set CutRow = BRange.Find("YES").EntireRow
ElseIf WorksheetFunction.CountIf(BRange, "YES") > 1 Then
'multiple YES found in col B

With BRange
Set c = .Find("YES")
firstAddress = c.Address
'Check for corresponding C value
If c.Offset(0, 1) <> "YES" Then
Do
Set c = .FindNext
Loop Until c.Offset(0, 1) = "YES" Or c.Address = firstAddress
End If
End With
Set CutRow = c.EntireRow
Else
'YES only found in col C
Set CutRow = CRange.Find("YES").EntireRow
End If

'Unfilter
ActiveSheet.Range("A1").AutoFilter Field:=4

'Delete this line if AutoFilter already activ4
DTable.Range("A1").AutoFilter
CutRow.Cut
xSelect.Cells(1, 1).Insert Shift:=xlDown
End Sub

[/pre]
If Autofilter already exists, remove the two lines I've marked for deletion.

 

[sparcle]

thank Luke sir for your time & effort you put on this.


once i check it i will notify you.

 

[sparcle]

@Luke


thank you sir it is absolutely flying.


you are such a genius thanks a lot.

 

[Luke M]

Awesome, thanks for the feedback. =)

 

[sparcle]

@Luke


Sir,

if it possible could you explain the code you written so that next time i put some extra condition on it, it may solve by me.


TimeStamp = Cells(ActiveCell.Row, "D").Value

Set DTable = Selection.CurrentRegion


'Delete this line if AutoFilter is already active

DTable.AutoFilter


'Filter down to just the relevant info

ActiveSheet.Range("A1").AutoFilter Field:=4, Criteria1:= _

"<=" & TimeStamp