auto sort colum

[Trevor3007]

hi,

can some canny person send me the VBA to auto sort A2:A200 so everytime a new enter is placed within the applicable it will A-Z automatically?

Many thanks in advance & for your help too.

KR
Trevor3007

 

[JoeMo]

This is sheet event code.
To install sheet code:
1. Right-click the worksheet tab you want to apply it to and choose 'View Code'. This will open the VBE window.
2. Copy the code below from your browser window and paste it into the white space in the VBE window.
3. Close the VBE window and Save the workbook. If you are using Excel 2007 or a later version do a SaveAs and save it as a macro-enabled workbook (.xlsm file extension).
4. Make sure you have enabled macros whenever you open the file or the code will not run.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range, c As Range
Set R = Range("A2:A200")
If Not Intersect(Target, R) Is Nothing Then
    Application.ScreenUpdating = false
    For Each c In Intersect(Target, R)
        R.Sort key1:=[A2], order1:=xlAscending
    Next c
End If
Application.ScreenUpdating = True
End Sub

 

[Trevor3007]

This is sheet event code.
To install sheet code:
1. Right-click the worksheet tab you want to apply it to and choose 'View Code'. This will open the VBE window.
2. Copy the code below from your browser window and paste it into the white space in the VBE window.
3. Close the VBE window and Save the workbook. If you are using Excel 2007 or a later version do a SaveAs and save it as a macro-enabled workbook (.xlsm file extension).
4. Make sure you have enabled macros whenever you open the file or the code will not run.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range, c As Range
Set R = Range("A2:A200")
If Not Intersect(Target, R) Is Nothing Then
    Application.ScreenUpdating = false
    For Each c In Intersect(Target, R)
        R.Sort key1:=[A2], order1:=xlAscending
    Next c
End If
Application.ScreenUpdating = True
End Sub

hi

thanks for your help.

I had to alter as the start cell ref was slightly different to what I 1st advised.


this is the code now :-

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range, c As Range
Set R = Range("A4:A200")
If Not Intersect(Target, R) Is Nothing Then
Application.ScreenUpdating = False
For Each c In Intersect(Target, R)
R.Sort key1:=[A4], order1:=xlAscending
Next c
End If
Application.ScreenUpdating = True
End Sub


but it did not work? (my changes are in RED )

KR
Trevor3007

 

[JoeMo]

"Did not work" is not useful information. Can you tell me exactly what happens or doesn't happen when you make a change to any cell in the range A4:A200? Also, can you confirm that you have installed the code in the appropriate worksheet and not as a standard module?

As a diagnostic, insert this line immediately before the Set R = ... line, and then make a change to any cell on the sheet and tell me if the message box pops up.

msgbox "HELLO - Events are enabled!"

 

[Trevor3007]

"Did not work" is not useful information. Can you tell me exactly what happens or doesn't happen when you make a change to any cell in the range A4:A200? Also, can you confirm that you have installed the code in the appropriate worksheet and not as a standard module?

As a diagnostic, insert this line immediately before the Set R = ... line, and then make a change to any cell on the sheet and tell me if the message box pops up.

msgbox "HELLO - Events are enabled!"

Hi,

thank you for getting back to me & sorry for the delay in replying to you.

I inserted

msgbox "HELLO - Events are enabled!" . But nothing appeared or changed

I think you have hit the nail on the head when you stated in your previous regarding 'where the code is'?

Its actually in a module & not the worksheet.




The 'worksheet' (rather than module' already has lots of code In :-



Private Sub Worksheet_Change(ByVal Target As Range)

' ********** CODE BLOCK 1 **********
Dim rng As Range
Dim rng2 As Range
Dim cell As Range
Dim R As Long
Dim c As Long

Set rng = Intersect(Target, Range("E2:H200"))

ActiveSheet.Unprotect
Application.EnableEvents = False

If Not rng Is Nothing Then
' Loop through updated cells in range
For Each cell In rng
' Get row and column number of updated cell
R = cell.Row
c = cell.Column
' Count how many cells have "Y" in current row
Set rng2 = Range("E" & R & ":H" & R)
If Application.WorksheetFunction.CountIf(rng2, "Y") > 1 Then
' Clear entry
cell.ClearContents
' Return message
MsgBox "You can put one Y in cell range E-H " & cell.Address(0, 0), vbOKOnly, "ERROR!"
ElseIf Application.WorksheetFunction.CountIf(rng2, "Y") = 1 Then
' See which column was updated and make appropriate adjustments
If LCase(cell) = "y" Then
Select Case c
' What to do if column E updated to "y"
Case 5
'enter any desired code here
' What to do if column F updated to "y"
Case 6
'enter any desired code here
' What to do if column G updated to "y"
Case 7
'enter any desired code here
' What to do if column H updated to "y"
Case 8
With Cells(R, "B")
.NumberFormat = "dd/mm/yyyy"
.Value = Date
End With
End Select
End If
Else
Cells(R, "B").Value = ""
End If
Next cell

Application.EnableEvents = True

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True

End If

' ********** CODE BLOCK 2 **********
Dim rng1 As Range
Dim cell1 As Range

' Check to see if any cells updated in range G2:G200 on "Builds" sheet
Set rng1 = Intersect(Target, Range("G2:G200"))

' Loop through updated cells
If Not rng1 Is Nothing Then
' Unprotect Reprove-Clear Flag Requests sheet
Sheets("Reprove-Clear Flag Requests").Activate
ActiveSheet.Unprotect
For Each cell1 In rng1
Select Case UCase(cell1)
' Add date stamp to column B on "Reprove-Clear Flag Requests" sheet if "Y" added to column G
Case "Y"
Sheets("Reprove-Clear Flag Requests").Cells(cell1.Row, "B") = Now()
'
End Select
Next cell1
' Reprotect sheet
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True
Sheets("Builds").Activate
End If

' ********** CODE BLOCK 3 **********
Dim rng3 As Range
Dim cell3 As Range

' Check to see if any cells updated in range H2:H200 on "Builds" sheet
Set rng3 = Intersect(Target, Range("H2:H200"))

' Loop through updated cells
If Not rng3 Is Nothing Then
' Unprotect sheet
ActiveSheet.Unprotect
For Each cell3 In rng3
Select Case UCase(cell3)
' Add date stamp to column B if "Y" added to column H
Case "Y"
Cells(cell3.Row, "B") = Now()
' Clear date stamp from column B if column H changed to blank
Case ""
Cells(cell3.Row, "B").ClearContents
End Select
Next cell3
' Reprotect sheet
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True
End If

Application.EnableEvents = True

End Sub




I also need to place your 'sort' VBA to run on 2 worksheets within the workbook. Sheet names:


sheet 2

and

Sheet 3


I tried to sort my self..but all I got was errors in compile.




Hoping you can sort & I have crossed fingers/eyes/toes etc.


KR
Trevor3007


_{^{<strike>
</strike>}}​

 

[JoeMo]

You need to merge the change_event code I gave you with the existing change_event code you have only now revealed. I also notice that at least one of the sheets you want to apply the code to is protected. Be sure you un-protect at the start of the code and re-protect at the end.

 

[Trevor3007]

You need to merge the change_event code I gave you with the existing change_event code you have only now revealed. I also notice that at least one of the sheets you want to apply the code to is protected. Be sure you un-protect at the start of the code and re-protect at the end.

hi Joe Mo,

thanks for getting back to me.

Whilst am canny at how the end interface should work & apart from a wee tweak here & there with ''record macro' am naff at the big lads stuff.

Would you be so kind & sort for me & amend accordingly please​

Many thanks for your help.
KR
Trevor3007

 

[Trevor3007]

evening JoeMo,

still struggling with this.

Is it possible to run the code in the applicable worksheet AUTOMATICALLY when ever a cell is changed . The range is a2:a200
any suggs please & hope you are have a good weekend.

MTIA
Ttevor