Results 1 to 14 of 14

Sorting export Data

Threaded View

  1. #10
    Forum Guru
    Join Date
    08-15-2004
    Location
    Tokyo, Japan
    MS-Off Ver
    2013 O.365
    Posts
    22,834

    Re: Sorting export Data

    Sub test()
        Dim a, i As Long, ii As Long, n As Long, AL As Object
        Dim myDate As Date
        Set AL = CreateObject("System.Collections.ArrayList")
        With Sheets("sheet1")
            a = .Range("b2", .Cells.SpecialCells(11)).Value
        End With
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 1 To UBound(a, 1)
                If a(i, 1) = "Employee" Then
                    For ii = 2 To UBound(a, 2)
                        If a(i, ii) Like "*##/##/####" Then
                            a(i, ii) = Replace(a(i, ii), vbLf, "")
                            a(i, ii) = DateSerial(Val(Right$(a(i, ii), 4)), _
                            Val(Mid$(a(i, ii), 7, 2)), Val(Mid$(a(i, ii), 4, 2)))
                        End If
                    Next
                    n = i
                Else
                    If a(i, 1) <> "" Then
                        If Not .exists(a(i, 1)) Then
                            Set .Item(a(i, 1)) = CreateObject("Scripting.Dictionary")
                        End If
                        For ii = 2 To UBound(a, 2)
                            If IsDate(a(n, ii)) Then
                                If Not AL.Contains(a(n, ii)) Then AL.Add a(n, ii)
                                .Item(a(i, 1))(a(n, ii)) = a(i, ii)
                            End If
                        Next
                    End If
                End If
            Next
            ReDim a(1 To .Count + 2, 1 To AL.Count + 1): AL.Sort
            For ii = 0 To AL.Count - 1
                a(1, ii + 2) = AL(ii): a(2, ii + 2) = AL(ii)
            Next
            For i = 0 To .Count - 1
                a(i + 3, 1) = .keys()(i)
                For ii = 2 To UBound(a, 2)
                    a(i + 3, ii) = .items()(i)(a(1, ii))
                Next
            Next
        End With
        With Sheets.Add.[b1].Resize(UBound(a, 1), UBound(a, 2))
            .Value = a
            .Offset(, 1).Resize(2, .Columns.Count - 1).BorderAround Weight:=2
            .Rows(1).NumberFormat = "yyyy/m/d"
            .Rows(2).NumberFormat = "ddd""""dd/mm/yyyy"
            .Columns(1).Offset(2).Resize(.Rows.Count - 2).Borders.Weight = 2
            .WrapText = False
            .Columns.AutoFit
            .Rows.AutoFit
            .Offset(, 1).HorizontalAlignment = xlCenter
            With .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 1)
                .Borders(11).LineStyle = xlDot
                .Borders(12).Weight = 2
                .BorderAround Weight:=2
            End With
            For ii = 2 To .Columns.Count Step 7
                .Columns(ii).Borders(7).LineStyle = 1
            Next
        End With
    End Sub
    Last edited by jindon; 04-03-2018 at 08:52 AM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Replies: 0
    Last Post: 11-10-2016, 10:18 AM
  2. Replies: 1
    Last Post: 12-16-2015, 01:04 PM
  3. Replies: 0
    Last Post: 12-02-2014, 05:02 PM
  4. Replies: 0
    Last Post: 02-24-2014, 11:27 AM
  5. Sorting 2 data ranges by comparing one column in each and sorting to match
    By MDKsmiffy in forum Excel Formulas & Functions
    Replies: 1
    Last Post: 06-17-2013, 03:30 PM
  6. I would need a macro to export data from base example workbook to export worbook
    By slato8 in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 10-01-2012, 11:21 AM
  7. Replies: 0
    Last Post: 10-14-2010, 08:22 AM

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1