auto sort

T

ttowncorp

Board Regular
Joined
Feb 2, 2015
Messages
187
Office Version
  1. 365
Platform
  1. Windows
this will be a major help but i'm not sure if anybody can help me. I have a massive data sheet that i would like to sort out. I dump the raw data on sheet two and would like to type in the item i want to see the history on in sheet one. example below sheet two then sheet one.
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]ticket id[/TD]
[TD]priority[/TD]
[TD]date of service[/TD]
[TD]vehicle id[/TD]
[TD]user name[/TD]
[TD]department[/TD]
[TD]status[/TD]
[TD]problem[/TD]
[TD]corrective action[/TD]
[TD]service date[/TD]
[TD]comments[/TD]
[TD]compliance[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]no[/TD]
[TD]5/1/19[/TD]
[TD]3201[/TD]
[TD]robert[/TD]
[TD]southern[/TD]
[TD]completed[/TD]
[TD]tires[/TD]
[TD]replaced tires[/TD]
[TD]5/1/19[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]yes[/TD]
[TD]5/2/19[/TD]
[TD]2200[/TD]
[TD]bob[/TD]
[TD]western[/TD]
[TD]active[/TD]
[TD]piston 4[/TD]
[TD]n/a[/TD]
[TD]n/a[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]no[/TD]
[TD]5/2/19[/TD]
[TD]2200[/TD]
[TD]bob[/TD]
[TD]western[/TD]
[TD]completed[/TD]
[TD]tires[/TD]
[TD]replaced tires[/TD]
[TD]5/2/19[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]no[/TD]
[TD]5/2/19[/TD]
[TD]2200[/TD]
[TD]bob[/TD]
[TD]western[/TD]
[TD]completed[/TD]
[TD]oil change[/TD]
[TD]replaced oil[/TD]
[TD]5/2/19[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"]2200[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ticket id[/TD]
[TD]priority[/TD]
[TD]date of service[/TD]
[TD]user name[/TD]
[TD]department[/TD]
[TD]status[/TD]
[TD]problem[/TD]
[TD]corrective action[/TD]
[TD]service date[/TD]
[TD]comments[/TD]
[TD]compliance[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]yes[/TD]
[TD]5/2/19[/TD]
[TD]bob[/TD]
[TD]western[/TD]
[TD]active[/TD]
[TD]piston 4[/TD]
[TD]n/a[/TD]
[TD]n/a[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]no[/TD]
[TD]5/2/19[/TD]
[TD]bob[/TD]
[TD]western[/TD]
[TD]completed[/TD]
[TD]tires[/TD]
[TD]replaced tires[/TD]
[TD]5/2/19[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]no[/TD]
[TD]5/2/19[/TD]
[TD]bob[/TD]
[TD]western[/TD]
[TD]completed[/TD]
[TD]oil change[/TD]
[TD]replaced oil[/TD]
[TD]5/2/19[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Sort by date Sort by votes
Assuming your Target.address = "Sheet1 F1" ( current value 2200), Data on sheet2.
Then try this "Change event" for results starting "Sheet1 A2" based on target cell "F1" value.
Code: 
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Application.EnableEvents = False
[COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "F1" [COLOR="Navy"]Then[/COLOR]
ray = Sheets("Sheet2").Range("A1").CurrentRegion
ReDim nRay(1 To UBound(ray, 1), 1 To UBound(ray, 2))
    [COLOR="Navy"]For[/COLOR] n = 1 To UBound(ray, 1)
        [COLOR="Navy"]If[/COLOR] ray(n, 4) = Target.Value Or ray(n, 4) = "vehicle id" [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            [COLOR="Navy"]For[/COLOR] ac = 1 To UBound(ray, 2)
                [COLOR="Navy"]If[/COLOR] IsDate(ray(n, ac)) [COLOR="Navy"]Then[/COLOR]
                    nRay(c, ac) = CDbl(DateValue(ray(n, ac)))
                [COLOR="Navy"]Else[/COLOR]
                    nRay(c, ac) = ray(n, ac)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] ac
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
Temp = Target
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1").Range("A2").Resize(c, 11)
    .Parent.Columns("A:L").ClearContents
    .Parent.Range("F1").Value = Temp
    .Value = Application.Index(nRay, Evaluate("Row(1:" & UBound(ray, 1) & ")"), Array(1, 2, 3, 5, 6, 7, 8, 9, 10, 11, 12))
    .Columns("C:C").NumberFormat = "dd/mm/yyy"
    .Columns("I:I").NumberFormat = "dd/mm/yyy"
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
this will work. I just have to tweek it a little. on sheet one it's overwriting anything on rows 1 and 2. what do i need for it to start populating on the 3rd row
 
Upvote 0
Try this:-
Code: 
Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
Application.EnableEvents = False
[COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "F1" [COLOR="Navy"]Then[/COLOR]
ray = Sheets("Sheet2").Range("A1").CurrentRegion
ReDim nRay(1 To UBound(ray, 1), 1 To UBound(ray, 2))
    [COLOR="Navy"]For[/COLOR] n = 1 To UBound(ray, 1)
        [COLOR="Navy"]If[/COLOR] ray(n, 4) = Target.Value Or ray(n, 4) = "vehicle id" [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            [COLOR="Navy"]For[/COLOR] ac = 1 To UBound(ray, 2)
                [COLOR="Navy"]If[/COLOR] IsDate(ray(n, ac)) [COLOR="Navy"]Then[/COLOR]
                    nRay(c, ac) = CDbl(DateValue(ray(n, ac)))
                [COLOR="Navy"]Else[/COLOR]
                    nRay(c, ac) = ray(n, ac)
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] ac
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n

[COLOR="Navy"]With[/COLOR] Sheets("Sheet1").Range("A3").Resize(c, 11)
     [COLOR="Navy"]Set[/COLOR] Rng = .Parent.Range("A3", .Parent.Range("A" & Rows.Count).End(xlUp))
     Rng.Resize(, 12).ClearContents
    .Value = Application.Index(nRay, Evaluate("Row(1:" & UBound(ray, 1) & ")"), Array(1, 2, 3, 5, 6, 7, 8, 9, 10, 11, 12))
    .Columns("C:C").NumberFormat = "dd/mm/yyy"
    .Columns("I:I").NumberFormat = "dd/mm/yyy"
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
question and sorry to bug you. my co-worker showed me this as well which i don't know if this is the same auto sort you help make me and since i don't know what these codes mean by you looking at it, is it the same or have extra coding in it. for example his Headers don't resize like mine do when I type in the vehicle ID number in the F1 box his which is set on D1. if i can get yours to do that, what would be awesome. thanks for your time.


Private Sub Worksheet_Change(ByVal Target As Range)
'******
Dim lastrow As Long
Dim lastcol As Long
Dim rng As String
Dim x As Long
Dim y As Long
Dim frng1 As String
Dim frng2 As String
cnt = 5 'first data row
lastrow = Sheet2.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
lastcol = Sheet2.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
If Target.Address = "$D$1" Then
Sheet1.Range("A5:IV65536") = "" 'clear previous
rng = "A1:A" & lastrow
If IsNumeric(Application.Match(Sheet1.Range("D1"), Sheet2.Range(rng), 0)) Then
For x = 1 To lastrow
If Sheet2.Cells(x, 1) = Sheet1.Range("D1") Then
Sheet1.Cells(cnt, 2) = Sheet2.Cells(x, 2) 'id
Sheet1.Cells(cnt, 3) = Sheet2.Cells(x, 3) 'date
For y = 1 To lastcol
If y >= 4 Then
Sheet1.Cells(cnt, y) = Sheet2.Cells(x, y) 'other elements
End If
Next y
cnt = cnt + 1
End If
Next x
'sort
lastrow = Sheet1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
frng1 = "B4:B" & lastrow
frng2 = "B4:E" & lastrow
Sheet1.Sort.SortFields.Clear
Sheet1.Sort.SortFields.Add Key:=Range(frng1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheet1.Sort
.SetRange Range(frng2)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'add issue count
For x = 5 To lastrow
Sheet1.Cells(x, 1) = x - 4
Next x


Else
MsgBox UCase(Sheet1.Range("D1")) & " No data has been entered for this bus at this current time.", vbCritical, "ALERT"
End If
End If
End Sub
 
Upvote 0
That code does not relate to the same columns in the Data.
What is it that you think this code has that you would like to have in your code.
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question Question
Help needed with creating a macro or function for finding specific keywords & then move to Sheet2
Replies
2
Views
494
kevin9999
K
HansM
  • Question Question
Looking for a specific number in a cell that can have multiple numbers separated by a comma (Using Mac Excel)
Replies
5
Views
312
Jeffrey Mahoney
Jeffrey Mahoney
A
  • Question Question
Fetch heads up stats between 2 teams
Replies
2
Views
281
AYouQueTai
A
I
  • Solved
Look for Cell Data in Cell Array, and Cell Data in Row Array and if match show this Cell Data
Replies
4
Views
246
Iccreamann21
I
S
  • Question Question
Create New Sheet with Specific Name Based on Variable Cell
Replies
0
Views
242
SBExcel123
S

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

Share this page

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