I have this code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 1 Then
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A5:J33" & lastRow).Sort key1:=Range("A5:A33" & lastRow), order1:=x1Ascending, Header:=xlNo
End If
End Sub
The Range I am trying to sort is A5:J33 and How I want it sorted is by the data in A5:A33 after it is enter
any help would be appreciated
You are getting the lastRow in column A lastRow = Cells(Rows.Count, 1).End(xlUp).Row , but you are not implementing the result correctly:
Range("A5:J33" & lastRow) and Range("A5:A33" & lastRow) should be Range("A5:J" & lastRow) and Range("A5:A" & lastRow).
Try the modified code below:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 1 Then
Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("A1:A" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A1:J" & lastRow)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End Sub
Related
I am trying to sort a list order to the order of BMC-, CSR-, MC- and CSR-. This list exist on column B and has data on column C.
Sub telecomsorter()
Dim vCustom_Sort As Variant, rr As Long
vCustom_Sort = Array("BMC-", "CSR-", "MC-", "LC-", Chr(42))
Application.AddCustomList ListArray:=vCustom_Sort
With Worksheets("TELECOM")
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row 'Find the last row for the given table
Range("B13:C" & LastRow).Select
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Add2 Key:=Range("B13:B47"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("TELECOM").Sort
.SetRange Range("B13:C" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
I want the list to be in the order of:
BMC-
CSR-
MC-
LC-
If there are multiple strings that are the same, then I want to sort according to the order of column C.
Give it a try to this... I removed the array and add the sorting values directly to the Sort properties.
CustomOrder:="BMC-,CSR-,MC-,LC-," & Chr(42) & ""
Option Explicit
Sub telecomsorter()
Dim LastRow As Long
With Worksheets("TELECOM")
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Range("B13:C" & LastRow).Select
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Add2 Key:=Range( _
"B14:B" & LastRow & ""), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"BMC-,CSR-,MC-,LC-," & Chr(42) & "", DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Add2 Key:=Range( _
"C14:C" & LastRow & ""), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("TELECOM").Sort
.SetRange Range("B13:C" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub
EDIT: I couldn't figure it out why the LC- always comes before the MC-, so I made a small function to do the workaround... it may not be the ideal solution but it works.
Option Explicit
Sub telecomsorter()
Dim LastRow As Long
Dim First As Long
Dim Last As Long
With Worksheets("TELECOM")
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
Range("B13:C" & LastRow).Select
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("TELECOM").Sort.SortFields.Add Key:=Range( _
"B14:B" & LastRow & ""), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"BMC-*,CSR-*,MC-*,LC-*," & Chr(42) & "", DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange Range("B14:C" & LastRow)
.Header = xlNo
.Orientation = xlTopToBottom
.Apply
End With
Call SortSpecial("LC-*", xlDescending)
Call SortSpecial("MC-*", xlAscending)
Call SortSpecial("LC-*", xlAscending)
End With
End Sub
Public Function SortSpecial(ByVal StrVal As String, ByVal SortOrder As XlSortOrder)
Dim First As Long
Dim Last As Long
First = Columns("B").Find(StrVal, , xlValues, , xlRows, xlNext, , , False).Row
Last = Columns("B").Find(StrVal, , xlValues, , xlRows, xlPrevious, , , False).Row
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=Range("B" & First & ":B" & Last), SortOn:=xlSortOnValues, Order:=SortOrder, DataOption:=xlSortNormal
With ActiveSheet.Sort
If SortOrder = xlAscending Then
.SetRange Range("B" & First & ":C" & Last)
Else
Last = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
.SetRange Range("B" & First & ":C" & Last)
End If
.Header = xlNo
.Orientation = xlTopToBottom
.Apply
End With
End Function
Trying to make a dynamic sort macro, works on first column, then I get an error when I try to run on new column (trying to sort each column A-Z without changing the order of the other columns).
Sub SortCell()
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Set sht = ActiveSheet
Set StartCell = ActiveCell
ActiveCell.Columns("A:A").EntireColumn.Select
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:= _
ActiveCell, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveSheet.Sort
.SetRange ActiveCell.Range(StartCell, sht.Cells(LastRow, LastColumn))
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MsgBox "Action complete.", vbInformation
End Sub
You're trying to work with the Sort code version that recording uses. This is very verbose and 'remembers' parameter values from previous operations. There is a much more concise syntax available that is just as effective.
dim c as long
with activesheet
for c=1 to .cells(1, .columns.count).end(xltoleft).column
if .cells(.rows.count, c).end(xlup).row >1 then
with .columns(c).Cells
.Sort Key1:=.cells(1), Order1:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlNo
end with
end if
next c
end with
i have a macro that sorts all my data based on a custom sort but i want to use it on different worksheets that has different last row "number" if so to speak and i have this code here but i keep getting an error:
and just so that u know i am sorting column O
Sub SortDays()
' SortDays Macro
lRow = Worksheets("Banner Summary").Cells(Rows.Count, "B").End(xlUp).Row
Range("B1").Select
Range("A1:A" & lRow).Select
Range("O2").Activate
ActiveWorkbook.Worksheets("Banner Summary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Banner Summary").Sort.SortFields.Add Key:=Range( _
"O2:O" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"M,T,W,R,F", DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Banner Summary").Sort
.SetRange Range("A1:A" & lRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
The error is: "The sort reference is not valid. Make sure that...."
it is quite long so any help would be really appreciated, and thnx in advance ^_^
Pass in the worksheet you want to sort:
Sub SortDays(byRef ws)
' SortDays Macro
lRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
'Range("B1").Select
'Range("A1:A" & lRow).Select
'Range("O2").Activate
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=Range( _
"O2:O" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"M,T,W,R,F", DataOption:=xlSortNormal
With ws.Sort
.SetRange Range("A1:O" & lRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Then this will run on any worksheet you pass it (assuming you have defined ws as whichever worksheet you want to use anyway:
Dim ws As Worksheet : Set ws = Workbooks("excelfilename").Worksheets("WhateverSheet")
prior to calling the Sub with SortDays ws
Sheet1= master field that I am trying to copy the content from the other sheets
Sheet2= Distributor1 Column A has UPC Column B Price Column C Shipping Price
Sheet3= Distributor2 Column A has UPC Column B Price Column C Shipping Price
In Sheet 1 I would like to paste/copy ALL UPC between sheet 2 and sheet 3. If there is a duplicate (comparing UPC) I would like the lesser of the two transferred over (less of the two column B price not worried about shipping).
I have been trying this all day and cannot get it. Tried copying all UPC to Sheet 1 from both sheets marked the duplicates i just can't get it to work so I don't have duplicated products. Any ideas what would be the easier way and a possible solution?
Give this code a shot. It should do what you need.
Sub RemoveDuplicateUPCsAndKeepLowestPrice()
Application.ScreenUpdating = False
Dim Sht1 As Integer
Dim Sht2 As Integer
Dim Sht3 As Integer
Sht2 = WorksheetFunction.CountA(Sheets("Sheet2").Range("A:A"))
Sht3 = WorksheetFunction.CountA(Sheets("Sheet3").Range("A:A"))
Sheets("Sheet1").Range("A:C").ClearContents
Sheets("Sheet1").Range("A1:A" & Sht2 + Sht3).NumberFormat = "#"
Sheets("Sheet1").Range("A1:C" & Sht2).Value = Sheets("Sheet2").Range("A1:C" & Sht2).Value
Sheets("Sheet1").Range("A" & Sht2 + 1 & ":C" & (Sht3 + Sht2 - 1)).Value = Sheets("Sheet3").Range("A2:C" & Sht3).Value
Sheets("Sheet1").Sort.SortFields.Clear
Sheets("Sheet1").Sort.SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Sheets("Sheet1").Sort.SortFields.Add Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With Sheets("Sheet1").Sort
.SetRange Range("A:C")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("Sheet1").Range("A:C").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
Sht1 = WorksheetFunction.CountA(Sheets("Sheet1").Range("A:A"))
For i = 1 To Sht1
If Sheets("Sheet1").Range("A" & i).Value = Sheets("Sheet1").Range("A" & (i + 1)).Value Then
Sheets("Sheet1").Range("A" & i & ":C" & i).ClearContents
End If
Next i
Sheets("Sheet1").Sort.SortFields.Clear
Sheets("Sheet1").Sort.SortFields.Add Key:=Range("A:A"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Sheets("Sheet1").Sort.SortFields.Add Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With Sheets("Sheet1").Sort
.SetRange Range("A:C")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.ScreenUpdating = True
End Sub
I have a script:
Sub wsPOT()
Dim wsPOT As Worksheet
Dim cel As Range
Dim lastrow As Long, lastrow2 As Long, fstcell As Long, i As Long, Er As Long, lstCol As Long, lstRow As Long
Set wsPOT = Sheets("PO Tracking")
With wsPOT
wsPOT.Range("Q1:U1").Copy
lastrow = wsPOT.Cells(Rows.Count, "B").End(xlUp).Row
wsPOT.Range("V1:X1").Copy wsPOT.Range("H3:J" & lastrow)
wsPOT.Range("N2:O2").Copy wsPOT.Range("N3:O" & lastrow)
wsPOT.Range("P1:V1").Copy
wsPOT.Range("B3:H" & lastrow).PasteSpecial xlPasteFormats
wsPOT.Range("K3:K" & lastrow).Borders.Weight = xlThin
lastrow = wsPOT.Cells(Rows.Count, "B").End(xlUp).Row
wsPOT.Range("H:J").Calculate
wsPOT.Range("B3:K" & lastrow).Sort key1:=Range("H3:H" & lastrow), order1:=xlAscending
lastrow2 = wsPOT.Cells(Rows.Count, "H").End(xlUp).Row
wsPOT.Range("B3:K" & lastrow2).Sort key1:=Range("H3:H" & lastrow2), order1:=xlDescending
End With
End Sub
This is meant to ultimately organize the sheet so that the the late jobs are on top, and then those are organized by oldest to youngest.
It seems not to work. What seems to happen is that the first orginization works fine, but then it seems to ignore the second criteria.
Attached is the sheet, with script.
https://dl.dropbox.com/u/3327208/Excel/Orga.xlsm
If someone can help look at this it be apprecaited.
Is this what you are trying?
Option Explicit
Sub wsPOT()
Dim wsPOT As Worksheet
Dim cel As Range
Dim lastrow As Long, lastrow2 As Long, fstcell As Long
Dim i As Long, Er As Long, lstCol As Long, lstRow As Long
Set wsPOT = Sheets("PO Tracking")
With wsPOT
.Range("Q1:U1").Copy
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
.Range("V1:X1").Copy .Range("H3:J" & lastrow)
.Range("N2:O2").Copy .Range("N3:O" & lastrow)
.Range("P1:V1").Copy
.Range("B3:H" & lastrow).PasteSpecial xlPasteFormats
.Range("K3:K" & lastrow).Borders.Weight = xlThin
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Range("H:J").Calculate
.Sort.SortFields.Clear
'~~> Sort on Red Icon First, putting it on top
.Sort.SortFields.Add(.Range("J3:J" & lastrow), _
xlSortOnIcon, xlAscending, , xlSortNormal).SetIcon Icon:=ActiveWorkbook. _
IconSets(4).Item(1)
'~~> Sort on Values of Red icon in descending order
.Sort.SortFields.Add Key:=Range( _
"J3:J" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
'~~> Sort on Green Icon Next, putting it on top after Red
.Sort.SortFields.Add(.Range("I3:I" & lastrow), _
xlSortOnIcon, xlAscending, , xlSortNormal).SetIcon Icon:=ActiveWorkbook. _
IconSets(4).Item(3)
'~~> Sort on Values of Green icon next in descending order
.Sort.SortFields.Add Key:=Range( _
"I3:I" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With .Sort
.SetRange wsPOT.Range("B2:K" & lastrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub