Move color cells down to selected cell

[sparcle]

Sir, if we store cells in array ascending order will it do the trick ?

 

[SirJB7]

Hi, sparcle!


Give a look at this file:

https://dl.dropbox.com/u/60558749/Move%20color%20cells%20down%20to%20selected%20cell%20-%20SEQ%20%28for%20sparcle%20at%20chandoo.org%29.xlsm


I added a command button for easier testing. Just advise if any issue.


Regards!


PS: This is the code, built from scratch.


-----

[pre]

Option Explicit

Sub F_____gMacro()
'
' constants
Const ksRangeAll = "A5:B13"
Const kiColorColumn = 1
Const kiOrderColumn = 2
Const kiOrder = xlAscending
'
' declarations
Dim rngAll As Range, rngSel As Range, rngSrt As Range
Dim lBaseRow As Long, lMovedRows As Long
Dim I As Long, J As Long
'
' start
'  ranges
Set rngAll = Range(ksRangeAll)
Set rngSel = Application.Intersect(Selection, rngAll)
'  valid selection
If rngSel Is Nothing Then
Exit Sub
Else
If rngSel.Cells.Count = 1 And rngSel.Cells(1, 1).Value = "" Or _
rngSel.Rows.Count > 1 Then Exit Sub
End If
'  initial rows
lBaseRow = rngSel.Row - rngAll.Row + 1
lMovedRows = 0
'
' process
With rngAll
' move
For I = lBaseRow + 1 To .Rows.Count
If .Cells(I, kiColorColumn).Interior.ColorIndex <> xlNone Then
J = lBaseRow + lMovedRows + 1
If I <> J Then
lMovedRows = lMovedRows + 1
.Rows(I).Cut
.Rows(J).Insert Shift:=xlShiftDown
End If
End If
Next I
' sort
If lMovedRows > 0 Then
Set rngSrt = Range(.Rows(lBaseRow + 1), .Rows(lBaseRow + lMovedRows))
rngSrt.Sort Key1:=.Columns(kiOrderColumn), Order1:=kiOrder, Header:=xlNo
Set rngSrt = Nothing
End If
End With
'
' end
'  positioning
rngAll.Cells(1, 1).Select
'  ranges
Set rngSel = Nothing
Set rngAll = Nothing
'  beep
Beep
'
End Sub

[/pre]
-----

 

[sparcle]

@ SirJB7,

Hello sir

Thank you for your help.It is quit long in term of code written, it take some hard work to do it.

Thanks again.


Sir it only move color cells column not entire row & it moves only if the cell selected above the color cells.

 

[SirJB7]

Hi, sparcle!


You have the download link too, for easy testing. I pasted the code as NARAYANK991 did it firstly, just reciprocity.


It moves all the row, as you asked upwards:

-----

.Rows(I).Cut

.Rows(J).Insert Shift:=xlShiftDown

-----


And it moves it only if colored, as you asked too:

-----

If .Cells(I, kiColorColumn).Interior.ColorIndex <> xlNone Then

-----


Regards!

Regards!

 

[sparcle]

Hello sir,

Yes it do the trick,but only upwards is there any way to move the cell downwards.


Thank you very much for your help sir.


Now i learn something about how to Undo Changes Done By Excel VBA.

Here is referance

http://www.jkp-ads.com/Articles/UndoWithVBA00.asp


does it do the trick those moved cell to original again.

 

[SirJB7]

Hi, sparcle!


I'm now getting why this topic goes by its 31st post. That wasn't specified in your requirements, and I quote NARAYANK991 ("Things are quite complicated , more so than originally posted." http://chandoo.org/forums/topic/move-color-cells-down-to-selected-cell#post-35100).


You required to move up colored cells ordered by date ascending, below selected cell/row.

My uploaded file does that. If I'm wrong, I apologize and humbly ask you to give me a couple of examples for which it doesn't work. If I'm right, then please reformulate the requirements in its definitive version, or better indeed give yourself a try and update the code as needed, just advise if any issue.


Regards!

 

[sparcle]

@SirJB7

Sir,Your code is absolutely correct & works as you describe.

I only extend my requirement a little bit more,my appolige for that & want to how cell will also move if selected cell is below color cell.


I will try & back if it is not done.

 

[SirJB7]

Hi, sparcle!


Thanks for the feedback, then I can discard this previous comment "Sir it only move color cells column not entire row & it moves only if the cell selected above the color cells.".


And about your reformulated requirements, would you please upload a workbook with a couple of examples before/after about how does macro should behave, as I don't fully understand from your explanation? Thank you.


Regards!

 

[sparcle]

Sir, i am working on reformulate the code & if it does give any solution then i will give you some trouble, asking it again.


Next time i will ask my requirement with clean explanation.


Again thank you sir for your help.