If cell is a certain value automatically move row into order

TheNarddog

New Member
Joined
Sep 28, 2022
Messages
5
Hi

If I have data from A2 (which includes the headings) to column I, with an unknown number of rows of data below (never more than 100 rows really) I was wondering if someone can help with a code for my spreadsheet. I've managed to do bits separately but can't combine it into 1 automated action as I'm not the best on excel.

If a cell in column G is double clicked, I want the cell in column G to fill with "Yes" and then the row automatically moves to the bottom of the data into order (with the other rows with a G cell filled as "Yes". The row would slot itself in terms of the order I mention in the next bit.

Secondly, I was wanting the rows of data from column A to I to automatically arrange itself when data is changed based on multiple headings.

So in terms of order:
Column G, ascending,
then Column A ascending
then Column F ascending
then Column E ascending

So if say data is changed in one of the rows of column A, that row would then jump into the correct order automatically without having to press Ctrl+ a key.

If this second bit can be done I wonder if that will automatically solve the first part of wanting "Yes" cells in row G to move automatically. It will also help for when the cell is turned back to "No" in column G for the row to jump back up the order.

I've been able to manage some of this in separate codes and using Ctrl+ a key to make the code run but I want to combine and automate it.

Thanks in advance.
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Try the following. Right click on the sheet tab, select View Code, and copy all of the code below to the window to the right. Save the file & test.

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Me.Range("G3", Cells(Rows.Count, "G").End(3)), Target) Is Nothing Then
        Cancel = True
        If Target.Value <> "Yes" Then Target.Value = "Yes"
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    Dim LRow As Long
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If Not Intersect(Me.Range("A3:I" & LRow), Target) Is Nothing Then
        Application.EnableEvents = False
        SortMe
    End If
    Application.EnableEvents = True
End Sub

Sub SortMe()
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    With Me.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("G2"), Order:=xlAscending
        .SortFields.Add Key:=Range("A2"), Order:=xlAscending
        .SortFields.Add Key:=Range("F2"), Order:=xlAscending
        .SortFields.Add Key:=Range("E2"), Order:=xlAscending
        .SetRange Range("A3:I" & LRow)
        .Apply
    End With
End Sub
 
Upvote 0
In hindsight, you could incorporate the Sort function inside the Worksheet Change event, like this:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Me.Range("G3", Cells(Rows.Count, "G").End(3)), Target) Is Nothing Then
        Cancel = True
        If Target.Value <> "Yes" Then Target.Value = "Yes"
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    Dim LRow As Long
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If Not Intersect(Me.Range("A3:I" & LRow), Target) Is Nothing Then
        Application.EnableEvents = False
        With Me.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("G2"), Order:=xlAscending
            .SortFields.Add Key:=Range("A2"), Order:=xlAscending
            .SortFields.Add Key:=Range("F2"), Order:=xlAscending
            .SortFields.Add Key:=Range("E2"), Order:=xlAscending
            .SetRange Range("A3:I" & LRow)
            .Apply
        End With
    End If
    Application.EnableEvents = True
End Sub
 
Upvote 0
Solution
In hindsight, you could incorporate the Sort function inside the Worksheet Change event, like this:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Me.Range("G3", Cells(Rows.Count, "G").End(3)), Target) Is Nothing Then
        Cancel = True
        If Target.Value <> "Yes" Then Target.Value = "Yes"
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    Dim LRow As Long
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If Not Intersect(Me.Range("A3:I" & LRow), Target) Is Nothing Then
        Application.EnableEvents = False
        With Me.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("G2"), Order:=xlAscending
            .SortFields.Add Key:=Range("A2"), Order:=xlAscending
            .SortFields.Add Key:=Range("F2"), Order:=xlAscending
            .SortFields.Add Key:=Range("E2"), Order:=xlAscending
            .SetRange Range("A3:I" & LRow)
            .Apply
        End With
    End If
    Application.EnableEvents = True
End Sub

That worked perfectly! Is there a way to add in a double click down column H so that when double clicked it adds todays date?

I’m wondering if you would know if there’s a way I can completely automate my worksheet now.

The code you created is needed on a sheet called USER. This sheet pulls data from the master list of data on a sheet called MAIN. At the moment I’m using a filter function but as I can’t edit the data it’s quite useless.

Is there a code that I can implement somewhere to copy the data from sheet MAIN and display it on the USER sheet, filtered?

The data on MAIN is from A2 (with headings) to column I with unlimited rows below.

For the extracted data from sheet MAIN, I need to include any rows from column F that say USER.

I need to include rows from column A for dates including today and up to 10 working days ahead.

I need to exclude rows from column E which say “Stop”.

Then finally include rows in column G for rows that say “No”.

Any help or advice would be massively appreciated.
 
Upvote 0
In hindsight, you could incorporate the Sort function inside the Worksheet Change event, like this:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Me.Range("G3", Cells(Rows.Count, "G").End(3)), Target) Is Nothing Then
        Cancel = True
        If Target.Value <> "Yes" Then Target.Value = "Yes"
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    Dim LRow As Long
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If Not Intersect(Me.Range("A3:I" & LRow), Target) Is Nothing Then
        Application.EnableEvents = False
        With Me.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("G2"), Order:=xlAscending
            .SortFields.Add Key:=Range("A2"), Order:=xlAscending
            .SortFields.Add Key:=Range("F2"), Order:=xlAscending
            .SortFields.Add Key:=Range("E2"), Order:=xlAscending
            .SetRange Range("A3:I" & LRow)
            .Apply
        End With
    End If
    Application.EnableEvents = True
End Sub
Alternatively, a potentially simpler option that could work better for me rather than my suggestion above is just to stay on the MAIN page but where I have dates in column A, I separated entries for each date by an empty row (just so I can clearly see the divide between data for each date) and then the code just ran for each date?

So the way your code sorted my data, that was able to just run for the first rows with the same date, then an empty line for separation of dates, then it sorted the data again for the next rows with the same date, and so forth?
 
Upvote 0
With regard to you first added requirement in post #4, please try the following code (change the date format to suit)

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Me.Range("G3", Cells(Rows.Count, "H").End(3)), Target) Is Nothing Then
        Cancel = True
        If Target.Column = 7 And Target.Value <> "Yes" Then Target.Value = "Yes"
        If Target.Column = 8 Then Target.Value = Format(Now(), "dd/mm/yyyy")    '<< change format to suit
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    Dim LRow As Long
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If Not Intersect(Me.Range("A3:I" & LRow), Target) Is Nothing Then
        Application.EnableEvents = False
        With Me.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("G2"), Order:=xlAscending
            .SortFields.Add Key:=Range("A2"), Order:=xlAscending
            .SortFields.Add Key:=Range("F2"), Order:=xlAscending
            .SortFields.Add Key:=Range("E2"), Order:=xlAscending
            .SetRange Range("A3:I" & LRow)
            .Apply
        End With
    End If
    Application.EnableEvents = True
End Sub

If that does what you want, mark the answer as a solution so others may find it. As far as all the other things go, please create a new thread because what you ask is considerably more/different from your initial question. On your new thread, be clear about what you want - for example, in your post #4 you talk about a number of conditions regarding extracting data, but you need to be clear as to whether it is condition 1 AND condition 2 or condition 1 OR condition 2 etc. (see what I mean?). Also decide if you want to go by your post #4 or your post #5.

Also, it will be of considerable help if you provide copies of your USER and MAIN sheets via the XL2BB add in so volunteers are able to test proposed code & not guess what your data looks like.
 
Upvote 0
With regard to you first added requirement in post #4, please try the following code (change the date format to suit)

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Me.Range("G3", Cells(Rows.Count, "H").End(3)), Target) Is Nothing Then
        Cancel = True
        If Target.Column = 7 And Target.Value <> "Yes" Then Target.Value = "Yes"
        If Target.Column = 8 Then Target.Value = Format(Now(), "dd/mm/yyyy")    '<< change format to suit
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    Dim LRow As Long
    LRow = Cells.Find("*", , xlFormulas, , 1, 2).Row
    If Not Intersect(Me.Range("A3:I" & LRow), Target) Is Nothing Then
        Application.EnableEvents = False
        With Me.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("G2"), Order:=xlAscending
            .SortFields.Add Key:=Range("A2"), Order:=xlAscending
            .SortFields.Add Key:=Range("F2"), Order:=xlAscending
            .SortFields.Add Key:=Range("E2"), Order:=xlAscending
            .SetRange Range("A3:I" & LRow)
            .Apply
        End With
    End If
    Application.EnableEvents = True
End Sub

If that does what you want, mark the answer as a solution so others may find it. As far as all the other things go, please create a new thread because what you ask is considerably more/different from your initial question. On your new thread, be clear about what you want - for example, in your post #4 you talk about a number of conditions regarding extracting data, but you need to be clear as to whether it is condition 1 AND condition 2 or condition 1 OR condition 2 etc. (see what I mean?). Also decide if you want to go by your post #4 or your post #5.

Also, it will be of considerable help if you provide copies of your USER and MAIN sheets via the XL2BB add in so volunteers are able to test proposed code & not guess what your data looks like.
Yes, please ignore post 4. Thanks so much for all your help, it's been really appreciated and I'll ask my question on another post.
 
Upvote 0
Yes, please ignore post 4. Thanks so much for all your help, it's been really appreciated and I'll ask my question on another post.
I see your new post (thank you). It'll be a few hours before I can get to it, but someone else may suggest a solution in the meantime.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

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