auto sort

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

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
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

Forum statistics

Threads
1,223,889
Messages
6,175,223
Members
452,620
Latest member
dsubash

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