VBA to put items in Chronological Order

[Glasgowsmile]

I'm trying to shift out old data when new data is added and then compare the dates to see where the new data should be placed.

Right now my big issue is the first If statement in the VBA. The worksheet has an IF to check those criteria and it's true by time I get to that part of the VBA code but that first IF statement isn't executing and I don't understand why.

Sub ImportChrono()
   
    NewBA = Sheet1.Range("B2").Value
    PBA = Sheet1.Range("D2").Value
    BA2 = Sheet1.Range("F2").Value
    BA3 = Sheet1.Range("H2").Value
        
        ' Clearing old data to make room for new data
        
        If Not IsEmpty(Sheet1.Range("A2, C2, E2, G2")) Then
            
            ' Delete the oldest record (3 records back)
            Sheet1.Range("G2:H4").ClearContents
        
            ' Copy 2 Records back to 3 Records Back
            Sheet1.Range("E2:F4").Copy Sheet1.Range("G2")
        
            ' Copy Previous Record to 2 Records Back
            Sheet1.Range("C2:D4").Copy Sheet1.Range("E2")
            
            ' Copy Current to Previous Record
            Sheet1.Range("A2:B4").Copy Sheet1.Range("C2")
            
            ' Add New Data
            Sheet1.Range("L2:M4").Copy Sheet1.Range("A2")
            
        End If

With Sheet1
    If NewBA > BA3 And NewBA > BA2 And NewBA < PBA Then
        .Range("A2:B4").Copy Destination:=.Range("Q2")
        .Range("C2:D2").Copy Destination:=.Range("A2")
        .Range("Q2:R4").Copy Destination:=.Range("C2")
    ElseIf NewBA > BA4 And NewBA > BA3 And NewBA <= BA2 And NewBA <= PBA Then
        .Range("L2:M4").Copy Destination:=.Range("E2")
    ElseIf NewBA > BA4 And NewBA <= BA3 And NewBA <= BA2 And NewBA <= PBA Then
        .Range("L2:M4").Copy Destination:=.Range("G2")
    End If
End With

End Sub

TestingChrono.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Current		Previous record		2 Records Back		3 Records Back
2	2/26/2022	3/1/2022	2/15/2022	2/25/2022	1/30/2022	2/14/2022	1/23/2022	1/29/2022				5/15/2022	2/27/2022
3	Col1	Col1	Col2	Col2	Col3	Col3	Col4	Col4				NEW DATA	NEW DATA
4	Col1	Col1	Col2	Col2	Col3	Col3	Col4	Col4				NEW DATA	NEW DATA
5
6		FALSE
7
Sheet1

Cell Formulas
Range	Formula
B6	B6	=IF(AND(B2>H2,B2>F2,B2<D2),TRUE,FALSE)

 

[BSALV]

without checking, it think you have to move the data first and then read your dates into variables.
so move the 1st 4 lines after the 1st if ... end if

 

[BSALV]

or (reverse sorting with small instead of large)

Sub ImportChrono()
     With sheet1
          .Range("A2:F4").Copy sheet1.Range("C2")
          .Range("L2:M4").Copy sheet1.Range("A2")

          For i = 1 To 4                                        'loop through your dates
               a = Array(.Range("B2").Value2 + 1 / 10000, .Range("D2").Value2 + 2 / 10000, .Range("F2").Value2 + 3 / 10000, .Range("H2").Value2 + 4 / 10000)     'array with your actual 4 dates (now double), add small value in case of duplicate values
               i1 = Application.Match(Application.Large(a, i), a, 0)     'position of the i-largest value in that array
               If i <> i1 Then                                  'wrong position
                    Set c1 = .Range("A2:B4").Offset(, (i - 1) * 2)     'actual data at that position
                    Set c2 = .Range("A2:B4").Offset(, (i1 - 1) * 2)     'wanted data at that position
                    Set c3 = .Range("Q2:R4")                    'auxiliary
                    c1.Copy c3                                  'copy actual to aux
                    c2.Copy c1                                  'copy wanted to actual
                    c3.Copy c2                                  'copy aux to wanted
               End If
          Next
     End With

End Sub

 

[Glasgowsmile]

without checking, it think you have to move the data first and then read your dates into variables.
so move the 1st 4 lines after the 1st if ... end if

Sorry I should have been more clear, the issue I was mentioned is in this code specifically.

With Sheet1
    If NewBA > BA3 And NewBA > BA2 And NewBA < PBA Then
        .Range("A2:B4").Copy Destination:=.Range("Q2")
        .Range("C2:D2").Copy Destination:=.Range("A2")
        .Range("Q2:R4").Copy Destination:=.Range("C2")
    ElseIf NewBA > BA4 And NewBA > BA3 And NewBA <= BA2 And NewBA <= PBA Then
        .Range("L2:M4").Copy Destination:=.Range("E2")
    ElseIf NewBA > BA4 And NewBA <= BA3 And NewBA <= BA2 And NewBA <= PBA Then
        .Range("L2:M4").Copy Destination:=.Range("G2")
    End If
End With

 

[Glasgowsmile]

or (reverse sorting with small instead of large)

Sub ImportChrono()
     With sheet1
          .Range("A2:F4").Copy sheet1.Range("C2")
          .Range("L2:M4").Copy sheet1.Range("A2")

          For i = 1 To 4                                        'loop through your dates
               a = Array(.Range("B2").Value2 + 1 / 10000, .Range("D2").Value2 + 2 / 10000, .Range("F2").Value2 + 3 / 10000, .Range("H2").Value2 + 4 / 10000)     'array with your actual 4 dates (now double), add small value in case of duplicate values
               i1 = Application.Match(Application.Large(a, i), a, 0)     'position of the i-largest value in that array
               If i <> i1 Then                                  'wrong position
                    Set c1 = .Range("A2:B4").Offset(, (i - 1) * 2)     'actual data at that position
                    Set c2 = .Range("A2:B4").Offset(, (i1 - 1) * 2)     'wanted data at that position
                    Set c3 = .Range("Q2:R4")                    'auxiliary
                    c1.Copy c3                                  'copy actual to aux
                    c2.Copy c1                                  'copy wanted to actual
                    c3.Copy c2                                  'copy aux to wanted
               End If
          Next
     End With

End Sub

This works for the basic setup but the final build is going to require moving 3 sets of data to the correct location.

I tried to expand on it but by time I get down to c1.Copy c3 I get an error "Action won't work with multiple selections", how would I work around that issue?

Sub ImportChrono()
     With Sheet1
          .Range("G2:H4").ClearContents
          .Range("E2:F4").Copy Sheet1.Range("G2")
          .Range("C2:D4").Copy Sheet1.Range("E2")
          .Range("A2:F4").Copy Sheet1.Range("C2")
          .Range("L2:M4").Copy Sheet1.Range("A2")
          .Range("L15:M16").Copy Sheet1.Range("A15")

          For i = 1 To 4                                        'loop through your dates
               a = Array(.Range("B2").Value2 + 1 / 10000, .Range("D2").Value2 + 2 / 10000, .Range("F2").Value2 + 3 / 10000, .Range("H2").Value2 + 4 / 10000)
               'array with your actual 4 dates (now double), add small value in case of duplicate values
               i1 = Application.Match(Application.Large(a, i), a, 0)     'position of the i-largest value in that array
               If i <> i1 Then                                  'wrong position
                    Set c1 = .Range("A2:B4, A15:B16").Offset(, (i - 1) * 2)     'actual data at that position
                    Set c2 = .Range("A2:B4, A15:B16").Offset(, (i1 - 1) * 2)     'wanted data at that position
                    Set c3 = .Range("Q2:R4, Q15:R16")                    'auxiliary
                    c1.Copy c3                                  'copy actual to aux
                    c2.Copy c1                                  'copy wanted to actual
                    c3.Copy c2                                  'copy aux to wanted
               End If
          Next
     End With

End Sub

 

[BSALV]

Sub ImportChrono()
With sheet1
.Range("A2:H4").Copy sheet1.Range("C2")
.Range("L2:M4").Copy sheet1.Range("A2")

For i = 1 To 5 'loop through your dates
a = Array(.Range("B2").Value2 + 1 / 10000, .Range("D2").Value2 + 2 / 10000, .Range("F2").Value2 + 3 / 10000, .Range("H2").Value2 + 4 / 10000, .Range("j2").Value2 + 5 / 10000) 'array with your actual 4 dates (now double), add small value in case of duplicate values
i1 = Application.Match(Application.Large(a, i), a, 0) 'position of the i-largest value in that array
If i <> i1 Then 'wrong position
Set c1 = .Range("A2:B4").Offset(, (i - 1) * 2) 'actual data at that position
Set c2 = .Range("A2:B4").Offset(, (i1 - 1) * 2) 'wanted data at that position
Set c3 = .Range("Q2:R4") 'auxiliary
c1.Copy c3 'copy actual to aux
c2.Copy c1 'copy wanted to actual
c3.Copy c2 'copy aux to wanted
End If
Next
End With

End Sub

 

[BSALV]

sorry, in previous post, i hadn't seen those rows 15:16

Sub ImportChrono()

     With Sheets("sheet1")
          .Range("A2:H4").Copy .Range("C2")                     '1st block of 3 rows
          .Range("L2:M4").Copy .Range("A2")

          .Range("A15:H16").Copy .Range("C15")                  '2nd block of 2 rows
          .Range("L15:M16").Copy .Range("A15")

          offset_Q = Columns("Q").Column - .Columns("A").Column     'Column Q is your aux. column = x columns to the right
          For i = 1 To 5                                        'loop through your dates
               a = Array(.Range("B2").Value2 + 1 / 10000, .Range("D2").Value2 + 2 / 10000, .Range("F2").Value2 + 3 / 10000, .Range("H2").Value2 + 4 / 10000, .Range("j2").Value2 + 5 / 10000)     'array with your actual 4 dates (now double), add small value in case of duplicate values
               i1 = Application.Match(Application.Large(a, i), a, 0)     'position of the i-largest value in that array
               If i <> i1 Then                                  'wrong position
                    For j = 0 To 1                              '2 loops, once for
                         If j = 0 Then Set c0 = .Range("A2:B4") Else Set c0 = .Range("A15:B16")     '1st or 2nd block
                         Set c1 = c0.Offset(, (i - 1) * 2)      'actual data at that position
                         Set c2 = c0.Offset(, (i1 - 1) * 2)     'wanted data at that position
                         Set c3 = c0.Offset(, offset_Q)         'auxiliary
                         c1.Copy c3                             'copy actual to aux
                         c2.Copy c1                             'copy wanted to actual
                         c3.Copy c2                             'copy aux to wanted
                    Next
               End If
          Next
     End With

End Sub

 

[Glasgowsmile]

sorry, in previous post, i hadn't seen those rows 15:16

Sub ImportChrono()

     With Sheets("sheet1")
          .Range("A2:H4").Copy .Range("C2")                     '1st block of 3 rows
          .Range("L2:M4").Copy .Range("A2")

          .Range("A15:H16").Copy .Range("C15")                  '2nd block of 2 rows
          .Range("L15:M16").Copy .Range("A15")

          offset_Q = Columns("Q").Column - .Columns("A").Column     'Column Q is your aux. column = x columns to the right
          For i = 1 To 5                                        'loop through your dates
               a = Array(.Range("B2").Value2 + 1 / 10000, .Range("D2").Value2 + 2 / 10000, .Range("F2").Value2 + 3 / 10000, .Range("H2").Value2 + 4 / 10000, .Range("j2").Value2 + 5 / 10000)     'array with your actual 4 dates (now double), add small value in case of duplicate values
               i1 = Application.Match(Application.Large(a, i), a, 0)     'position of the i-largest value in that array
               If i <> i1 Then                                  'wrong position
                    For j = 0 To 1                              '2 loops, once for
                         If j = 0 Then Set c0 = .Range("A2:B4") Else Set c0 = .Range("A15:B16")     '1st or 2nd block
                         Set c1 = c0.Offset(, (i - 1) * 2)      'actual data at that position
                         Set c2 = c0.Offset(, (i1 - 1) * 2)     'wanted data at that position
                         Set c3 = c0.Offset(, offset_Q)         'auxiliary
                         c1.Copy c3                             'copy actual to aux
                         c2.Copy c1                             'copy wanted to actual
                         c3.Copy c2                             'copy aux to wanted
                    Next
               End If
          Next
     End With

End Sub

Thanks for this, I'm in over my head on this one. lol. I'll have to spend some time watching it run so I can have a better understanding of what's going on and how I can adopt something like this for my final build.

 

[Glasgowsmile]

So I updated it with more data and notes to give a better idea of what I'm trying to do.

The user is going to import 3 sets of data (at one time) and it goes into 3 separate areas on the sheet depending on the date at the top and placement of the first set. Currently I'm only attempting to get it done with 2 locations.

This clears the data, moves it and does the placement of the first data set without issue.

The data set from A16 on however doesn't work and I'm not experienced enough with this code to know where to go from here. If you could give me some direction on how to expand. I don't want to keep bothering you, lol.

As you can probably tell, you can ignore the template for reset data that was just to make it easier to make changes and re-run the code.

Sub ImportChrono()
    With Sheets("sheet1")
          .Range("G2:H14, A43:F50").ClearContents ' Clear oldest data set
          .Range("E2:F14").Copy Sheet1.Range("G2") ' Move 3rd data set to 4th
          .Range("A34:F41").Copy Sheet1.Range("A43")
         
          .Range("C2:D14").Copy Sheet1.Range("E2") ' Move 2nd data set to 3rd
          .Range("A25:F32").Copy Sheet1.Range("A34")
         
          .Range("A2:F14").Copy Sheet1.Range("C2") ' Move 1st data set to 2nd
          .Range("A16:F23").Copy Sheet1.Range("A25")
         
          .Range("L2:M14").Copy Sheet1.Range("A2") ' Imported data from user goes inot first dataset
          .Range("O3:T10").Copy Sheet1.Range("A16") ' but needs below function to determine actual placement based on end date

          offset_Q = Columns("V").Column - .Columns("A").Column     'Column V is your aux. column = x columns to the right
          For i = 1 To 5                                        'loop through your dates
               a = Array(.Range("B2").Value2 + 1 / 10000, .Range("D2").Value2 + 2 / 10000, .Range("F2").Value2 + 3 / 10000, .Range("H2").Value2 + 4 / 10000, .Range("j2").Value2 + 5 / 10000)     'array with your actual 4 dates (now double), add small value in case of duplicate values
               i1 = Application.Match(Application.Large(a, i), a, 0)     'position of the i-largest value in that array
               If i <> i1 Then                                  'wrong position
                    For j = 0 To 1                              '2 loops, once for
                         If j = 0 Then Set c0 = .Range("A2:B14") Else Set c0 = .Range("A16:F23")     '1st or 2nd block
                         Set c1 = c0.Offset(, (i - 1) * 2)      'actual data at that position
                         Set c2 = c0.Offset(, (i1 - 1) * 2)     'wanted data at that position
                         Set c3 = c0.Offset(, offset_Q)         'auxiliary
                         c1.Copy c3                             'copy actual to aux
                         c2.Copy c1                             'copy wanted to actual
                         c3.Copy c2                             'copy aux to wanted
                    Next
               End If
          Next
     End With
End Sub

TestingChrono.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W
1	1st Data Set		2nd Data Set		3rd Data set		4th Data set					New data being imported by user
2	2/26/2022	3/1/2022	2/15/2022	2/25/2022	1/30/2022	2/14/2022	1/23/2022	1/29/2022				5/15/2022	2/27/2022
3	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW		NEW	NEW	NEW	NEW	NEW	NEW
4	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW		NEW	NEW	NEW	NEW	NEW	NEW
5	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW		NEW	NEW	NEW	NEW	NEW	NEW
6	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW		NEW	NEW	NEW	NEW	NEW	NEW
7	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW		NEW	NEW	NEW	NEW	NEW	NEW
8	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW		NEW	NEW	NEW	NEW	NEW	NEW
9	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW		NEW	NEW	NEW	NEW	NEW	NEW
10	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW		NEW	NEW	NEW	NEW	NEW	NEW
11	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW
12	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW
13	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW
14	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4				NEW	NEW
15
16	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1
17	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1
18	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1			Template for reset
19	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1			Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Template for reset
20	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1			Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	########	3/1/2022	########	########	########	########	########	########
21	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1			Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
22	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1			Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
23	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1			Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
24									Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
25	Data 2	Data 2	Data 2	Data 2	Data 2	Data 2			Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
26	Data 2	Data 2	Data 2	Data 2	Data 2	Data 2			Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
27	Data 2	Data 2	Data 2	Data 2	Data 2	Data 2									Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
28	Data 2	Data 2	Data 2	Data 2	Data 2	Data 2			Data 2	Data 2	Data 2	Data 2	Data 2	Data 2	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
29	Data 2	Data 2	Data 2	Data 2	Data 2	Data 2			Data 2	Data 2	Data 2	Data 2	Data 2	Data 2	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
30	Data 2	Data 2	Data 2	Data 2	Data 2	Data 2			Data 2	Data 2	Data 2	Data 2	Data 2	Data 2	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
31	Data 2	Data 2	Data 2	Data 2	Data 2	Data 2			Data 2	Data 2	Data 2	Data 2	Data 2	Data 2	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
32	Data 2	Data 2	Data 2	Data 2	Data 2	Data 2			Data 2	Data 2	Data 2	Data 2	Data 2	Data 2	Data 1	Data 1	Data 2	Data 2	Data 3	Data 3	Data 4	Data 4
33									Data 2	Data 2	Data 2	Data 2	Data 2	Data 2
34	Data 3	Data 3	Data 3	Data 3	Data 3	Data 3			Data 2	Data 2	Data 2	Data 2	Data 2	Data 2
35	Data 3	Data 3	Data 3	Data 3	Data 3	Data 3			Data 2	Data 2	Data 2	Data 2	Data 2	Data 2
36	Data 3	Data 3	Data 3	Data 3	Data 3	Data 3
37	Data 3	Data 3	Data 3	Data 3	Data 3	Data 3			Data 3	Data 3	Data 3	Data 3	Data 3	Data 3
38	Data 3	Data 3	Data 3	Data 3	Data 3	Data 3			Data 3	Data 3	Data 3	Data 3	Data 3	Data 3
39	Data 3	Data 3	Data 3	Data 3	Data 3	Data 3			Data 3	Data 3	Data 3	Data 3	Data 3	Data 3
40	Data 3	Data 3	Data 3	Data 3	Data 3	Data 3			Data 3	Data 3	Data 3	Data 3	Data 3	Data 3
41	Data 3	Data 3	Data 3	Data 3	Data 3	Data 3			Data 3	Data 3	Data 3	Data 3	Data 3	Data 3
42									Data 3	Data 3	Data 3	Data 3	Data 3	Data 3
43	Data 4	Data 4	Data 4	Data 4	Data 4	Data 4			Data 3	Data 3	Data 3	Data 3	Data 3	Data 3
44	Data 4	Data 4	Data 4	Data 4	Data 4	Data 4			Data 3	Data 3	Data 3	Data 3	Data 3	Data 3
45	Data 4	Data 4	Data 4	Data 4	Data 4	Data 4
46	Data 4	Data 4	Data 4	Data 4	Data 4	Data 4			Data 4	Data 4	Data 4	Data 4	Data 4	Data 4
47	Data 4	Data 4	Data 4	Data 4	Data 4	Data 4			Data 4	Data 4	Data 4	Data 4	Data 4	Data 4
48	Data 4	Data 4	Data 4	Data 4	Data 4	Data 4			Data 4	Data 4	Data 4	Data 4	Data 4	Data 4
49	Data 4	Data 4	Data 4	Data 4	Data 4	Data 4			Data 4	Data 4	Data 4	Data 4	Data 4	Data 4
50	Data 4	Data 4	Data 4	Data 4	Data 4	Data 4			Data 4	Data 4	Data 4	Data 4	Data 4	Data 4
51									Data 4	Data 4	Data 4	Data 4	Data 4	Data 4
52									Data 4	Data 4	Data 4	Data 4	Data 4	Data 4
53									Data 4	Data 4	Data 4	Data 4	Data 4	Data 4
54
55
Sheet1

 

[BSALV]

2 macros, the 1st is to fill a sheet with data and only while testing in an empty sheet
the 2nd is for real.
Later you can eliminate all those msgboxes and application.goto's , they are there for demonstration

Sub NewStart_Reset()
     '*********************************************
     'this macro is just for making a new fresh start, while testing
     '*********************************************
     With Sheets("sheet1")
          .UsedRange.Clear
          .Cells.HorizontalAlignment = xlCenter

          Set Block1 = .Range("A16:F23")                        'a block of data
          For i = 0 To 3
               Block1.Offset(i * (Block1.Rows.Count + 1)).Value = "data" & i + 1
          Next
          .Range("O3:T10").Value = "data0"

          Set Block2 = .Range("A2:B14")                         'range of your 1st data set in the rows 2:14
          For i = 0 To 2
               Block2.Offset(, i * 2).Value = "data" & i + 1
          Next
          .Range("L2:M14").Value = "data0"                      ' Imported data from user goes inot first dataset
          With Range("A2:m2")
               .Value = [transpose(44555+row(A1:A100)*7)]       'fill 2nd row with dates
               .NumberFormat = "mm/dd/YY"                       'apply dateformat on that row
          End With

     End With
End Sub

Sub ImportChrono()
     With Sheets("sheet1")

     '************************************************************
     'you have 4 blocks of 8*6, copy 3 blocks 1  block down and copy a new one on top
     '*************************************************************
          Set Block1 = .Range("A16:F23")                        'a block of data
          For i = 2 To 0 Step -1                                'you have 4 sets of those data, move them by 1, vertical
               Application.Goto Block1.Offset(i * (Block1.Rows.Count + 1)), 1
               MsgBox "copy : " & Block1.Offset(i * (Block1.Rows.Count + 1)).Address & vbLf & " to : " & Block1.Offset((i + 1) * (Block1.Rows.Count + 1)).Address
               Block1.Offset(i * (Block1.Rows.Count + 1)).Copy Block1.Offset((i + 1) * (Block1.Rows.Count + 1))
          Next
          MsgBox "copy : " & .Range("O3:T10").Address & vbLf & " to : " & .Range("A16").Address
          .Range("O3:T10").Copy .Range("A16")                   ' move a new block in the first

     '***************************************************************************************
     'you have 4 blocks of 13*2 (but is 1 contigious block), copy 3 blocks 1  block to the right and copy a new one on LHS
     '***************************************************************************************
          Application.Goto .Range("A1")
          Set Block2 = .Range("A2:B14")                         'range of your 1st data set in the rows 2:14
          MsgBox "copy : " & Block2.Resize(, 6).Address & vbLf & " to : " & Block2.Offset(, 2).Address
          Application.DisplayAlerts = False                     'disable warnings
          Block2.Resize(, 6).Copy Block2.Offset(, 2)            'copy 3 of those sets, 1 set(=2 columns) to the right
          Application.DisplayAlerts = True
          MsgBox "copy : " & .Range("L2:M14").Address & vbLf & " to : " & .Range("A2").Address
          .Range("L2:M14").Copy .Range("A2")                    ' Imported data from user goes inot first dataset

     '*****************************************************
     'now check that those 4 relevant cells are sorted in a descending order
     '*****************************************************
          offset_Q = Columns("V").Column - .Columns("A").Column     'Column V is your aux. column = x columns to the right
          For i = 1 To 4                                        'loop through your dates
     'make sure that those cells have valid date-values !!!!!
               a = Array(.Range("B2").Value2 - 1 / 10000, .Range("D2").Value2 - 2 / 10000, .Range("F2").Value2 - 3 / 10000, .Range("H2").Value2 - 4 / 10000)     'array with your actual 4 dates (now double), add small value in case of duplicate values
               i1 = Application.Match(Application.Large(a, i), a, 0)     'position of the i-largest value in that array
               If i <> i1 Then                                  'wrong position
                    Set c0 = .Range("A2:B14")                   '1st block
                    Set c1 = c0.Offset(, (i - 1) * 2)           'actual data at that position
                    Set c2 = c0.Offset(, (i1 - 1) * 2)          'wanted data at that position
                    Set c3 = c0.Offset(, offset_Q)              'auxiliary
                    MsgBox Format(c1.Cells(1, 2), "mm/dd/yy") & "   " & Format(c2.Cells(1, 2), "mm/dd/yy") & vbLf & "swap " & c1.Address & " with " & c2.Address
                    c1.Copy c3                                  'copy actual to aux
                    c2.Copy c1                                  'copy wanted to actual
                    c3.Copy c2                                  'copy aux to wanted
               End If
          Next
     End With
End Sub