Transpose with dates problem - from the dd/mm/yy to mm/dd/yyyy

[pcardenasm]

Hi,

I need some help again, I have a problem when I transpose a date range, some dates are changed from the dd/mm/yy to mm/dd/yyyy.

Puntos-registro.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
1	Punto	07/03/2017	13/03/2017	20/03/2017	27/03/2017	03/04/2017	12/04/2017	18/04/2017	25/04/2017	02/05/2017	08/05/2017	15/05/2017	22/05/2017	29/05/2017	05/06/2017	12/06/2017	19/06/2017	28/06/2017	03/07/2017	14/07/2017	21/07/2017	24/07/2017
2	2	30.0	42.0	27.0	27.0	26.0	27.0	27.0	26.0	27.0	29.0	30.0	32.0	39.0	34.0	30.0	33.0	31.0	25.0	29.0	31.0	32.0
3	3	25.0	42.0	54.0	24.0	18.0	34.0	50.0	52.0	25.0	55.0	34.0	53.0	24.0	25.0	47.0	29.0	25.0	60.0	27.0	71.0	61.0
4	4	13.9	39.9	53.9	24.9	17.9	34.9	49.9	51.9	26.9	53.9	34.9	52.9	23.9	23.9	44.9	28.9	24.9	58.9	27.9	70.9	58.9
5	5	31.2	40.2	28.2	28.2	25.2	33.2	27.2	25.2	28.2	28.2	30.2	34.2	34.2	40.2	28.2	30.2	29.2	23.2	29.2	32.2	33.2
6	8	15.6	35.6	35.6	23.6	16.6	29.6	34.6	35.6	24.6	44.6	28.6	44.6	21.6	23.6	33.6	24.6	22.6	36.6	20.6	35.6	34.6
7	9	-1.4	2.6	1.6	-1.4	-2.4	-5.4	-7.4	-9.4	-4.4	-3.4	-3.4	-3.4	-5.4	-5.4	-7.4	-8.4	-5.4	-9.4	-16.4	-18.4	-18.4
8	10	15.0	35.0	35.0	25.0	17.0	30.0	35.0	35.0	26.0	45.0	19.0	44.0	12.0	24.0	34.0	14.0	15.0	36.0	23.0	34.0	35.0
9	11	-3.5	-20.5	-23.5	-18.5	-19.5	-14.5	-11.5	-8.5	4.5	8.5	6.5	-4.5	-11.5	-12.5	-16.5	-21.5	-24.5	-22.5	-11.5	-19.5	-14.5
10	12	-2.9	35.1	36.1	25.1	19.1	31.1	35.1	34.1	26.1	44.1	29.1	38.1	23.1	24.1	32.1	26.1	25.1	35.1	22.1	35.1	35.1
11	13	-3.4	10.6	0.6	-2.4	5.6	4.6	3.6	9.6	26.6	34.6	25.6	34.6	-2.4	-0.4	4.6	-0.4	-1.4	3.6	-1.4	3.6	0.6
12	14	32.1	45.1	26.1	25.1	25.1	26.1	27.1	28.1	27.1	39.1	30.1	54.1	32.1	35.1	40.1	35.1	35.1	41.1	35.1	42.1	41.1
13	15	30.1	37.1	24.1	25.1	24.1	26.1	26.1	25.1	27.1	28.1	29.1	32.1	-3.9	-3.9	-3.9	-3.9	-3.9	-3.9	-3.9	-3.9	-3.9
14	16	-3.2	-0.2	-1.2	-3.2	-7.2	2.8	2.8	8.8	24.8	33.8	24.8	36.8	-3.2	-1.2	0.8	-1.2	-2.2	2.8	-2.2	2.8	-1.2
15	17	-23.5	-21.5	-25.5	-23.5	-21.5	-16.5	-12.5	-9.5	2.5	7.5	5.5	-7.5	-12.5	-13.5	-21.5	-23.5	-29.5	-26.5	-12.5	-21.5	-15.5
16	18	-1.6	1.4	0.4	-1.6	-4.6	-7.6	-7.6	-10.6	-4.6	-1.6	-2.6	-4.6	-6.6	-5.6	-7.6	-10.6	-6.6	-10.6	-17.6	-20.6	-20.6
17	19	-31.4	-31.4	-34.4	-35.4	-35.4	-38.4	-41.4	-42.4	-39.4	-41.4	-40.4	-35.4	-35.4	-34.4	-36.4	-37.4	-38.4	-38.4	-35.4	-35.4	-37.4
18	20	-38.8	-34.8	-38.8	-38.8	-39.8	-38.8	-38.8	-38.8	-38.8	-38.8	-41.8	-38.8	-41.8	-39.8	-28.8	-37.8	-37.8	-37.8	-38.8	-36.8	-38.8
19	21	-7.1	-5.1	-11.1	-11.1	-11.1	-8.1	-9.1	-9.1	-7.1	-12.1	-12.1	-9.1	-13.1	-9.1	-11.1	-11.1	-12.1	-9.1	-12.1	-11.1	-11.1
20	22	-8.5	-18.5	-22.5	-12.5	-21.5	-10.5	-10.5	-11.5	-7.5	-23.5	-13.5	-11.5	-13.5	-10.5	-11.5	-12.5	-13.5	-10.5	-10.5	-12.5	-13.5
21	23	-42.8	-38.8	-43.8	-39.8	-42.8	-48.8	-40.8	-41.8	-43.8	-44.8	-44.8	-40.8	-46.8	-40.8	-40.8	-44.8	-44.8	-39.8	-46.8	-46.8	-40.8
22	24	-44.3	-35.3	-44.3	-40.3	-44.3	-52.3	-42.3	-44.3	-44.3	-44.3	-47.3	-44.3	-45.3	-45.3	-46.3	-45.3	-45.3	-45.3	-45.3	-39.3	-42.3
23	25	-43.9	-39.9	-43.9	-38.9	-43.9	-49.9	-41.9	-42.9	-45.9	-45.9	-45.9	-43.9	-46.9	-41.9	-40.9	-44.9	-44.9	-40.9	-44.9	-43.9	-41.9
24	26	-42.8	-35.8	-41.8	-40.8	-42.8	-43.8	-43.8	-43.8	-43.8	-43.8	-38.8	-41.8	-41.8	-41.8	-43.8	-43.8	-43.8	-41.8	-40.8	-40.8	-42.8
25	27	-45.6	-38.6	-45.6	-40.6	-45.6	-46.6	-41.6	-43.6	-46.6	-45.6	-46.6	-43.6	-47.6	-41.6	-41.6	-41.6	-40.6	-40.6	-45.6	-43.6	-42.6
26	28	-44.2	-41.2	-45.2	-40.2	-44.2	-50.2	-41.2	-42.2	-45.2	-44.2	-46.2	-42.2	-48.2	-43.2	-42.2	-46.2	-45.2	-41.2	-48.2	-46.2	-41.2
27	29	-45.8	-42.8	-44.8	-40.8	-44.8	-49.8	-42.8	-42.8	-46.8	-43.8	-46.8	-43.8	-47.8	-44.8	-42.8	-46.8	-45.8	-42.8	-48.8	-47.8	-41.8
28	30	-44.7	-40.7	-45.7	-49.7	-43.7	-50.7	-40.7	-42.7	-45.7	-44.7	-45.7	58.3	-46.7	-43.7	-41.7	-45.7	-44.7	-40.7	-46.7	-46.7	-40.7
29	32	-44.4	-41.4	-44.4	-39.4	-34.4	-50.4	-41.4	-42.4	-46.4	-45.4	-46.4	-42.4	-47.4	-45.4	-42.4	-45.4	-46.4	-41.4	-47.4	-47.4	-42.4
30	33	-44.5	-42.5	-44.5	-39.5	-43.5	-48.5	-42.5	-42.5	-45.5	-43.5	-44.5	-42.5	-47.5	-45.5	-41.5	-45.5	-44.5	-41.5	-48.5	-47.5	-41.5
31	34	32.1	36.1	27.1	27.1	27.1	28.1	28.1	27.1	27.1	30.1	31.1	30.1	31.1	34.1	27.1	29.1	31.1	25.1	29.1	32.1	33.1
32	35	-45.3	-43.3	-45.3	-40.3	-44.3	-51.3	-41.3	-42.3	-45.3	-44.3	-46.3	-42.3	-48.3	-44.3	-42.3	-46.3	-48.3	-40.3	-48.3	-47.3	-41.3
33	36	-44.3	-43.3	-43.3	-38.3	-42.3	-47.3	-40.3	-41.3	-42.3	-42.3	-44.3	-36.3	-45.3	-42.3	-40.3	-45.3	-44.3	-40.3	-45.3	-44.3	-40.3
34	38	121.0	148.0	159.0	131.0	126.0	143.0	156.0	159.0	133.0	160.0	116.0	156.0	131.0	132.0	154.0	136.0	133.0	167.0	134.0	176.0	163.0
SeguimientoAbs

I wrote a code to order by dates and point of registry:

Sub TransposeRange()
    Dim Lastcolumn As Variant
    Dim LastRowNiv As Variant
    Dim LastRow As Variant
    Dim MyRange As Variant
    Dim firstRow As Long
    Dim numfilas As Variant
    Dim RangoNiv As Variant
    Dim RangoPuntos As Variant
    Dim element As Variant
    Dim numcolumns As Integer
    Dim k As Variant
    Dim numcolumndatos As Variant
    Dim numfilasdatos As Variant
    Dim k1 As Variant
    
    Application.ScreenUpdating = False
    firstRow = 2
    LastRow = Sheets("PorPuntos").Range("A" & Rows.Count).End(xlUp).Row
    If LastRow < 2 Then LastRow = 2
    Sheets("PorPuntos").Range("A2:C" & LastRow).ClearContents
    Lastcolumn = Sheets("SeguimientoAbs").Cells(1, Columns.Count).End(xlToLeft).Column
    LastRowNiv = Sheets("SeguimientoAbs").Range("A" & Rows.Count).End(xlUp).Row
    
    
    
    PuntosArray = Array(2, 3, 4, 5, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 32, 33, 34, 35, 36, 38)
    
    For Each element In PuntosArray
    

    
    MyRange = Sheets("SeguimientoAbs").Range(Cells(1, 2).Address, Cells(1, Lastcolumn).Address)
        'find dimensions of range
        XUpper = UBound(MyRange, 1)
        XLower = LBound(MyRange, 1)
        YUpper = UBound(MyRange, 2)
        YLower = LBound(MyRange, 2)
    
        'transpose range

        Sheets("PorPuntos").Range("A" & firstRow).Resize(YUpper - YLower + 1, XUpper - XLower + 1).Value = _
        Application.Transpose(MyRange)
        
        LastRow = Sheets("PorPuntos").Range("A" & Rows.Count).End(xlUp).Row
        RangoNiv = Sheets("SeguimientoAbs").Range(Cells(2, 2).Address, Cells(LastRowNiv, Lastcolumn).Address)
        RangoPuntos = Sheets("SeguimientoAbs").Range(Cells(2, 1).Address, Cells(LastRowNiv, 1).Address)
        
            For numfilas = firstRow To LastRow
                numfilasdatos = numfilas - 1
                numcolumndatos = Lastcolumn - 1
                If numfilas <= Lastcolumn Then
                        numcolumns = numfilas - 1
                
                    ElseIf numfilasdatos Mod numcolumndatos = 0 Then
                        numcolumns = Lastcolumn - 1
                    
                        ElseIf numfilas > Lastcolumn Then
                            numcolumns = numfilasdatos - WorksheetFunction.RoundDown(numfilasdatos / numcolumndatos, 0) * numcolumndatos

                        
                End If
                
                Sheets("PorPuntos").Cells(numfilas, 2) = element
                
                k = Application.WorksheetFunction.Index(RangoNiv, Application.WorksheetFunction.Match(element, RangoPuntos, 0), numcolumns)

                If IsEmpty(k) Then
                    k1 = ""
                Else
                    k1 = k
                End If

                Sheets("PorPuntos").Cells(numfilas, 3) = k1

            Next numfilas
        
        firstRow = LastRow + 1
        Application.CutCopyMode = False

        Next element
    
    Application.ScreenUpdating = True
    Sheets("PorPuntos").Select
    Range("B2").Select
    MsgBox "Valores copiados exitosamente", vbInformation, "Copiar"
    

      
End Sub

But I have some errors in some dates

Puntos-registro.xlsm
	A	B	C
1	Fecha	Punto	Nivel (Abs)
2	03/07/2017	2	30.0
3	13/03/2017	2	42.0
4	20/03/2017	2	27.0
5	27/03/2017	2	27.0
6	04/03/2017	2	26.0
7	04/12/2017	2	27.0
8	18/04/2017	2	27.0
9	25/04/2017	2	26.0
10	05/02/2017	2	27.0
11	05/08/2017	2	29.0
12	15/05/2017	2	30.0
13	22/05/2017	2	32.0
14	29/05/2017	2	39.0
15	06/05/2017	2	34.0
16	06/12/2017	2	30.0
17	19/06/2017	2	33.0
18	28/06/2017	2	31.0
19	07/03/2017	2	25.0
20	14/07/2017	2	29.0
21	21/07/2017	2	31.0
22	24/07/2017	2	32.0
23	24/08/2017	2	30.0
24	30/08/2017	2	39.0
25	09/04/2017	2	33.0
26	09/11/2017	2	33.0
27	18/09/2017	2	31.0
28	25/09/2017	2	29.0
29	10/02/2017	2	29.0
PorPuntos

File-xlsm

I hope you can help me. Thank you

Patricia CM

 

[Kerryx]

Think the VBA issue is due to default date format but an alternative solution is PQ
This can be done in Power query very easily

Book1
	A	B	C
1	Fecha	Punto	Nivel (Abs)
2	07/03/2017	2	30
3	13/03/2017	2	42
4	20/03/2017	2	27
5	27/03/2017	2	27
6	03/04/2017	2	26
7	12/04/2017	2	27
8	18/04/2017	2	27
9	25/04/2017	2	26
10	02/05/2017	2	27
11	08/05/2017	2	29
12	15/05/2017	2	30
13	22/05/2017	2	32
14	29/05/2017	2	39
15	05/06/2017	2	34
16	12/06/2017	2	30
17	19/06/2017	2	33
18	28/06/2017	2	31
19	03/07/2017	2	25
20	14/07/2017	2	29
21	21/07/2017	2	31
22	24/07/2017	2	32
23	07/03/2017	3	25
24	13/03/2017	3	42
25	20/03/2017	3	54
26	27/03/2017	3	24
Table1

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Punto", Int64.Type}, {"07/03/2017", type number}, {"13/03/2017", type number}, {"20/03/2017", type number}, {"27/03/2017", type number}, {"03/04/2017", type number}, {"12/04/2017", type number}, {"18/04/2017", type number}, {"25/04/2017", type number}, {"02/05/2017", type number}, {"08/05/2017", type number}, {"15/05/2017", type number}, {"22/05/2017", type number}, {"29/05/2017", type number}, {"05/06/2017", type number}, {"12/06/2017", type number}, {"19/06/2017", type number}, {"28/06/2017", type number}, {"03/07/2017", type number}, {"14/07/2017", type number}, {"21/07/2017", type number}, {"24/07/2017", type number}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Punto"}, "Attribute", "Value"),
    #"Reordered Columns" = Table.ReorderColumns(#"Unpivoted Other Columns",{"Attribute", "Punto", "Value"}),
    #"Renamed Columns" = Table.RenameColumns(#"Reordered Columns",{{"Attribute", "Fecha"}, {"Value", "Nivel (Abs)"}})
in
    #"Renamed Columns"

 

[Alex Blakenburg]

Try changing this line to be Value2 (add the 2 on the end)

    MyRange = Sheets("SeguimientoAbs").Range(Cells(1, 2).Address, Cells(1, Lastcolumn).Address).Value2

 

[pcardenasm]

Try changing this line to be Value2 (add the 2 on the end)

    MyRange = Sheets("SeguimientoAbs").Range(Cells(1, 2).Address, Cells(1, Lastcolumn).Address).Value2

Hi,
Thank you so much Alex!!!, it works well.

 

[Alex Blakenburg]

Thanks for letting us know. Glad we could help.