ttowncorp

Board Regular
Joined
Feb 2, 2015
Messages
183
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.
ticket idprioritydate of servicevehicle iduser namedepartmentstatusproblemcorrective actionservice datecommentscompliance
1no5/1/193201robertsoutherncompletedtiresreplaced tires5/1/19
2yes5/2/192200bobwesternactivepiston 4n/an/a
3no5/2/192200bobwesterncompletedtiresreplaced tires5/2/19
4no5/2/192200bobwesterncompletedoil changereplaced oil5/2/19

<tbody>
</tbody>

2200
ticket idprioritydate of serviceuser namedepartmentstatusproblemcorrective actionservice datecommentscompliance
2yes5/2/19bobwesternactivepiston 4n/an/a
3no5/2/19bobwesterncompletedtiresreplaced tires5/2/19
4no5/2/19bobwesterncompletedoil changereplaced oil5/2/19

<tbody>
</tbody>
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
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
it's still F1 but my titles of the columns start from A2 to K2.
 
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,213,484
Messages
6,113,923
Members
448,533
Latest member
thietbibeboiwasaco

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