VBA formula to copy format and paste cells for dates?

ThePangloss

New Member
Joined
Jun 19, 2015
Messages
40
I've got this code
Code:
[/FONT][FONT=Courier New]Sub Datar()
Dim sel As Range, ass1start As Range, ass1end As Range 
Dim ass2start As Range, ass2end As Range
Dim temp1 As Range, temp2 As RangeSet 
sel = Selection
For Each Row In sel.Rows
 Set ass1start = Row.Cells(1, 1)
 Set ass1end = Row.Cells(1, 2)
 Set ass2start = Row.Cells(1, 3)
 Set ass2end = Row.Cells(1, 4)
 If IsEmpty(ass2start) Or IsEmpty(ass2end) Then
 'next ElseIf ass1start = ass2start And ass1end > ass2end Then 
ass2end.Copy Row.Cells(1, 2) 
ass1end.Copy Row.Cells(1, 4) 
ElseIf ass1start > ass2start Then 
' ass1start.Copy Row.Cells(1, 3) = temp1 
' ass1end.Copy Row.Cells(1, 4) = temp2 
Set temp1 = Row.Cells(1, 1) 
Set temp2 = Row.Cells(1, 2) 
ass2start.Copy Row.Cells(1, 1) 
ass2end.Copy Row.Cells(1, 2) 
temp1.Copy Row.Cells(1, 3) 
temp2.Copy Row.Cells(1, 4) 
End 
IfNext
End Sub
[/FONT][FONT=Courier New]



The problem is, it's supposed to switch ass1start and ass2start and ass1end and ass2end, but instead it pastes both ass2start and ass2end into both.

So lets say I have this

Assignment 1 startAssignment 1 endAssignment 2 StartAssignment 2 end
1/10/20072/12/20085/6/20051/9/2006
1/20/20082/20/20092/21/20092/27/2009

<tbody>
</tbody>


What it should do is take the two dates that are before the first two, (5/6/2005 and 1/9/2006 and replace them with 1/10/2007 and 2/12/2008 and then put 5/6/2005 and 1/9/2006 into the first two cells of the row.)
The second row is fine because they're all chronologically placed.

Instead I get something like this

Assignment 1 startAssignment 1 endAssignment 2 StartAssignment 2 end
5/6/20051/9/20065/6/20051/9/2006
1/20/20082/20/20092/21/20092/27/2009

<tbody>
</tbody>

where it just copied the last two and didn't paste the first two inplace of the last two. Any ideas? I'd like to preserve formatting of the cells as well because the colors I have on the cells help me differentiate assignments from different contractors. So assignment 1 start and end might be green, and assignment 2 start and end might be blue. I'd like to keep them those colors when switched.

Thanks in advance.
 
Last edited:

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Here's the problem:

Code:
Set temp1 = Row.Cells(1, 1)
ass2start.Copy Row.Cells(1, 1)  'temp1.Value has just been overwritten!
temp1.Copy Row.Cells(1, 3)

Here's one way you could modify your code:

Code:
Dim dteTemp1 As Date

dteTemp1 = Row.Cells(1, 1).Value
ass2start.Copy Row.Cells(1, 1)
ass2start.Value = dteTemp1
 
Upvote 0

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,399
Latest member
alchavar

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