Moving Select Cell Values to Another Cell.

skeet4me

New Member
Joined
Dec 11, 2003
Messages
27
This is the last thing I have to figure out and my project is finished. (y) ! This is a great resource and I appreciate all the help I've gotten.

I have a group of cells D21:D46 that may or may not have entries. The entires will start at D21 and the last possible entry would be in D46. The catch is that not all cells have to have entries in them. Using VBA, I have to move the last five cell values in order (from D46 down to D21) to D18 down to D14.

I'm sure I can come up with something that would probably be brute force and not very efficient, so I figured I'd get some advice from the experts. Appreciate any ideas.
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
If possible, just delete the empty cells down-up, then the last five values will move to where they should be. Try following codes:

Sub DeleteEmptyCells()
Dim i As Integer
Dim MyCell As Range
For i = 46 To 21 Step -1
Set MyCell = Range("D" & i)
If MyCell = "" Then
MyCell.EntireRow.Delete
End If
Next i
End Sub
 
Upvote 0
Not clear if by this:
"(from D46 down to D21) to D18 down to D14."
you really mean in reverse order, since 21 is less than 46 and 14 is less than 18, so maybe you meant up instead of down.

Also, by this:
"I have to move"
maybe that means cut and paste ("move") or less likely but possibly copied and pasted, or just the values copied and the original cells left intact.

The below macro copies the values only. If you need the cells cut and pasted (or copied and pasted, meaning including formats etc) please post back.




Sub Test1()
Range("D14:D18").ClearContents
Dim i%, j%
j = 18
For i = 46 To 21 Step -1
If Len(Cells(i, 4)) > 0 Then
Cells(j, 4).Value = Cells(i, 4).Value
j = j - 1
If j < 14 Then Exit For
End If
Next i
End Sub
 
Upvote 0
Alright, here's my crappy version. If you can't afford to delete an entire row.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Find_Five()

<SPAN style="color:#00007F">Dim</SPAN> MyFive(4) <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> ItemNum <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> RowNum <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>

    ItemNum = -1
    <SPAN style="color:#00007F">For</SPAN> RowNum = 46 <SPAN style="color:#00007F">To</SPAN> 21 <SPAN style="color:#00007F">Step</SPAN> -1
        <SPAN style="color:#00007F">If</SPAN> ItemNum < 4 <SPAN style="color:#00007F">Then</SPAN>
            <SPAN style="color:#00007F">If</SPAN> Len(Range("D" & RowNum).Value) <> 0 <SPAN style="color:#00007F">Then</SPAN>
                ItemNum = ItemNum + 1
                MyFive(ItemNum) = Range("D" & RowNum).Value
            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
        <SPAN style="color:#00007F">Else</SPAN>
            <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">For</SPAN>
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> RowNum
    Range("D21:D46").ClearContents
    <SPAN style="color:#00007F">For</SPAN> ItemNum = 1 <SPAN style="color:#00007F">To</SPAN> <SPAN style="color:#00007F">UBound</SPAN>(MyFive) + 1
        Range("D" & 20 + ItemNum).Value = MyFive(UBound(MyFive) + 1 - ItemNum)
    <SPAN style="color:#00007F">Next</SPAN> ItemNum

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

P.S. I like Tom's approach better. I just like using variable arrays! :pray:
 
Upvote 0
Thanks everyone, and Tom you were correct. Sorry, it was late and I was tired. I need to transfer the cell values to the other cells, and your code does exactly what I need. One of many and then I will clear the cells once complete. I can handle the rest. Your solution is close to what I was going to do anyway, but my would not have been so to the point. Thanks for the help everyone!
 
Upvote 0

Forum statistics

Threads
1,218,809
Messages
6,144,606
Members
450,559
Latest member
kwenda farai

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top