k0st4din
05-15-2023, 10:22 PM
Hello, everyone,
I have a macro that in the mentioned worksheet, adds new records in two columns if there is no data already entered.
However, right now, it's adding in column B and column D. I'm trying to change this rearrangement slightly, so that when there's an add after ordering for A-Z, but it grabs the whole range of B:E and sorts things again A-Z from column D, not as it is currently separately for D and B.
I made a macro manually, what I want to happen to me, but I don't know how to keep the same actions of the whole macro, but only change the rearrangement.
I would be grateful for your assistance.
Perhaps I should add, for more clarity:
The macro adds the writing from another two-column worksheet to this worksheet in columns B and D, but when they are added, it then reorders separately for each of the columns in the form A-Z.
And I want to change it a bit, so that when the given word is written and saved in the Base worksheet, the ordering spans from B to D, and when the rearrangement occurs, the one written in D matches the one in B, not each column should be on its own.
I remain available for further clarification.
ActiveSheet.Unprotect "k0"
On Error Resume Next
Dim ws As Worksheet
Dim str As String
Dim i As Integer
Dim rngDV As Range
Dim rng As Range
If Target.CountLarge > 1 Then Exit Sub
Set ws = Worksheets("Base")
If Target.Row > 1 Then
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rngDV Is Nothing Then Exit Sub
If Intersect(Target, rngDV) Is Nothing Then Exit Sub
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
On Error Resume Next
Set rng = ws.Range(str)
On Error GoTo 0
If rng Is Nothing Then Exit Sub
If Application.WorksheetFunction _
.CountIf(rng, Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
ws.Cells(i, rng.Column).Value = Target.Value
rng.Sort Key1:=ws.Cells(1, rng.Column), _ ' I thing here must be changed
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If
ActiveSheet.Protect "k0"
End Sub
Or maybe if it can be changed in the macro itself somehow without adding my idea
******This is the macro I made myself and I'm trying
to add(change) it to the above macro in its order*******
Columns("B:E").Select
ActiveWorkbook.Worksheets("Base").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Base").Sort.SortFields.Add Key:=Range("D2:D400"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Base").Sort
.SetRange Range("B2:E400")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
3081630817
I have a macro that in the mentioned worksheet, adds new records in two columns if there is no data already entered.
However, right now, it's adding in column B and column D. I'm trying to change this rearrangement slightly, so that when there's an add after ordering for A-Z, but it grabs the whole range of B:E and sorts things again A-Z from column D, not as it is currently separately for D and B.
I made a macro manually, what I want to happen to me, but I don't know how to keep the same actions of the whole macro, but only change the rearrangement.
I would be grateful for your assistance.
Perhaps I should add, for more clarity:
The macro adds the writing from another two-column worksheet to this worksheet in columns B and D, but when they are added, it then reorders separately for each of the columns in the form A-Z.
And I want to change it a bit, so that when the given word is written and saved in the Base worksheet, the ordering spans from B to D, and when the rearrangement occurs, the one written in D matches the one in B, not each column should be on its own.
I remain available for further clarification.
ActiveSheet.Unprotect "k0"
On Error Resume Next
Dim ws As Worksheet
Dim str As String
Dim i As Integer
Dim rngDV As Range
Dim rng As Range
If Target.CountLarge > 1 Then Exit Sub
Set ws = Worksheets("Base")
If Target.Row > 1 Then
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rngDV Is Nothing Then Exit Sub
If Intersect(Target, rngDV) Is Nothing Then Exit Sub
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
On Error Resume Next
Set rng = ws.Range(str)
On Error GoTo 0
If rng Is Nothing Then Exit Sub
If Application.WorksheetFunction _
.CountIf(rng, Target.Value) Then
Exit Sub
Else
i = ws.Cells(Rows.Count, rng.Column).End(xlUp).Row + 1
ws.Cells(i, rng.Column).Value = Target.Value
rng.Sort Key1:=ws.Cells(1, rng.Column), _ ' I thing here must be changed
Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End If
ActiveSheet.Protect "k0"
End Sub
Or maybe if it can be changed in the macro itself somehow without adding my idea
******This is the macro I made myself and I'm trying
to add(change) it to the above macro in its order*******
Columns("B:E").Select
ActiveWorkbook.Worksheets("Base").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Base").Sort.SortFields.Add Key:=Range("D2:D400"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Base").Sort
.SetRange Range("B2:E400")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
3081630817