Sort data according to value

[liaoz01]

Hi,

Can someone please help me to edit the below code? Having problem with the underlined portion. It is always showing the following error message - "Run-time error '1004' -Application-defined or object-defined error". Thanks in advance, any help is much appreciated!

Sub Macro1()
'
' Macro1 Macro
'
'
    Application.ScreenUpdating = False
    Sheets("B-Output").Range("B13:I18").Copy
    Sheets("B-Output (HC)").Range("B13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("B-Output").Range("B26:AA80").Copy
    Sheets("B-Output (HC)").Range("B26").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("B-Output").Range("B94:AA156").Copy
    Sheets("B-Output (HC)").Range("B94").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    With Sheets("B-Output (HC)").Range("B28:AA63,B68:AA79,B96:AA110,B115:AA155").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    Sheets("B-Output (HC)").Range("B28:AA62").Sort Key1:=Sheets("B-Output (HC)").Range("J28:J62"), Order1:=xlDescending, _
    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    
    Sheets("B-Output (HC)").Range("B68:AA78").Sort Key1:=Sheets("B-Output (HC)").Range("J68:J78"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    
    Sheets("B-Output (HC)").Range("B96:AA109").Sort Key1:=Sheets("B-Output (HC)").Range("J96:J109"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    
    Sheets("B-Output (HC)").Range("B115:AA154").Sort Key1:=Sheets("B-Output (HC)").Range("J115:J154"), Order1:=xlDescending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
     
    [U]With Sheets("B-Output (HC)").Range("B29:AA29,B31:AA31,B33:AA33,B35:AA35,B37:AA37,B39:AA39,B41:AA41,B43:AA43,B45:AA45,B47:AA47,B49:AA49,B51:AA51,B53:AA53,B55:AA55,B57:AA57,B59:AA59,B61:AA61,B69:AA69,B71:AA71,B73:AA73,B75:AA75,B77:AA77,B97:AA97,B99:AA99,B101:AA101,B103:AA103,B105:AA105,B107:AA107,B109:AA109,B116:AA116,B118:AA118,B120:AA120,B122:AA122,B124:AA124,B126:AA126,B128:AA128,B130:AA130,B132:AA132,B134:AA134,B136:AA136,B138:AA138,B140:AA140,B142:AA142,B144:AA144,B146:AA146,B148:AA148,B150:AA150,B152:AA152,B154:AA154").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
[/U]       
    Application.ScreenUpdating = True
    
End Sub

 

[RickXL]

I think you might be having string length problems - not sure.

However, why not use a loop?

Replace your With/End With section with this:

    For iRow = 29 To 154 Step 2
        With Sheets("SB-Output (HC)").Cells(iRow, 2).Resize(1, 26).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.149998474074526
            .PatternTintAndShade = 0
        End With
    Next