Organizing by color - excel

Question

I have run into an issue, I have a script thanks to several members here has allowed me to import directly from a file into a workbook. With that same script I've incorporated the ability to organize by color red on top, and green underneith. I thought I could write the code to make it so that yellow would be in the middle myself, but it doesn't take into concideration it seems the difference between yellow and red, although I thought I did make that difference noticable though the script.
If someone can look at this and tell me where I am going wrong it would be greatly apprecaited.
This is what I get now for an end result, the yellow is on the bottom of the sheet btw after importing.
The code for some reason isn't reading right, so attached is also a link to the sheet, with the added file to import.
Zip File
or the files seperate here...
Sheet
CSV
Here is my code:
Option Explicit
Sub Update_POT()
Dim wsPOD As Worksheet
Dim wsPOT As Worksheet
Dim wsPOA As Worksheet
Dim cel As Range
Dim lastrow As Long, fstcell As Long, i As Long, Er As Long, lstCol As Long, lstRow As Long, strFile As String
Set wsPOD = Sheets("PO Data")
Set wsPOT = Sheets("PO Tracking")
Set wsPOA = Sheets("PO Archive")
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With wsPOD
.Columns("A:AB").ClearContents
.Range("Y1").Formula = "=COUNTIFS('PO Tracking'!$D:$D,$C1,'PO Tracking'!$C:$C,$D1,'PO Tracking'!$F:$F,$G1)"
.Range("Z1").Formula = "=IF($M1,"""",""Different"")"
.Range("AA1").Formula = "=IF(ISBLANK($C1),0,1)"
.Range("AB1").Formula = "=IF($O1,""Full"","""")"
End With
strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please selec text file...")
With wsPOD.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=wsPOD.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
With wsPOD
'first bring columns F:G up to match their line
For Each cel In Intersect(.UsedRange, .UsedRange.Offset(5), .Columns(6))
If cel = vbNullString And cel.Offset(, -2) <> vbNullString Then
.Range(cel.Offset(1), cel.Offset(1, 1)).Copy cel
cel.Offset(1).EntireRow.Delete
End If
Next
'now fil columns A:D to match PO Date and PO#
For Each cel In Intersect(.UsedRange, .UsedRange.Offset(5), .Columns(1))
If cel = vbNullString And cel.Offset(, 5) <> vbNullString Then
.Range(cel.Offset(-1), cel.Offset(-1, 3)).Copy cel
End If
Next
lastrow = wsPOD.Cells(Rows.Count, "J").End(xlUp).Row
fstcell = wsPOD.Cells(Rows.Count, "N").End(xlUp).Row
wsPOD.Range("Y1:AB1").Copy wsPOD.Range("M" & fstcell & ":P" & lastrow)
wsPOD.Range("M:P").Calculate
End With
With Intersect(wsPOD.UsedRange, wsPOD.Columns("P"))
.AutoFilter 1, "<>Full"
With Intersect(.Offset(2).EntireRow, .Parent.Range("A:P"))
.EntireRow.Delete
End With
.AutoFilter
End With
With Intersect(wsPOD.UsedRange, wsPOD.Columns("N"))
.AutoFilter 1, "<>Different"
With Intersect(.Offset(2).EntireRow, .Parent.Range("A:P"))
.EntireRow.Delete
End With
.AutoFilter
End With
'Final Adjustments before transfering over to PO Tracking.
With wsPOD
.AutoFilterMode = False
lastrow = wsPOD.Cells(Rows.Count, "A").End(xlUp).Row
Intersect(.UsedRange, .Range("A4:A" & lastrow)).Cut .Range("Q3")
Intersect(.UsedRange, .Columns("D")).Cut .Range("R1")
Intersect(.UsedRange, .Columns("C")).Cut .Range("S1")
Intersect(.UsedRange, .Columns("B")).Cut .Range("T1")
Intersect(.UsedRange, .Columns("G")).Cut .Range("U1")
Intersect(.UsedRange, .Columns("F")).Cut .Range("V1")
End With
With wsPOD
wsPOD.Columns("A:P").ClearContents
lastrow = wsPOD.Cells(Rows.Count, "Q").End(xlUp).Row
wsPOD.Range("Q3:V" & lastrow).Copy wsPOT.Cells(Rows.Count, "B").End(xlUp).Offset(1)
End With
'Format 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 PO Tracking
'Sort Reds
.Sort.SortFields.Add(.Range("J3:J" & lastrow), _
xlSortOnIcon, xlAscending, , xlSortNormal).SetIcon Icon:=ActiveWorkbook. _
IconSets(4).Item(1)
.Sort.SortFields.Add Key:=Range( _
"J3:J30" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
'Sort Yellows
.Sort.SortFields.Add(.Range("I3:I" & lastrow), _
xlSortOnIcon, xlAscending, , xlSortNormal).SetIcon Icon:=ActiveWorkbook. _
IconSets(4).Item(2)
.Sort.SortFields.Add Key:=Range( _
"I3:I" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
'Sort Greens
.Sort.SortFields.Add(.Range("I3:I" & lastrow), _
xlSortOnIcon, xlAscending, , xlSortNormal).SetIcon Icon:=ActiveWorkbook. _
IconSets(4).Item(3)
.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
With wsPOD
wsPOD.Columns("Q:X").ClearContents
wsPOD.Cells(1, 25).Value = "=COUNTIFS('PO Tracking'!$D:$D,$C1,'PO Tracking'!$C:$C,$D1,'PO Tracking'!$F:$F,$G1)"
wsPOD.Cells(1, 27).Value = "=IF(ISBLANK($C1),0,1)"
wsPOD.Range("Y1:AB1").Copy wsPOD.Range("M5:P5")
End With
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Answer 1

You have to remove the line
.Sort.SortFields.Add Key:=Range( _
"I3:I" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
in
'Sort Yellows
.Sort.SortFields.Add(.Range("I3:I" & lastrow), _
xlSortOnIcon, xlAscending, , xlSortNormal).SetIcon Icon:=ActiveWorkbook. _
IconSets(4).Item(2)
.Sort.SortFields.Add Key:=Range( _
"I3:I" & lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
You cannot have have the same duplicate sort conditions for both Yellow and Green in the same column. Remove that line and try again.