VBA - simple sort is killing me!

zookeepertx

Active Member
Joined
May 27, 2011
Messages
480
Hello all!

This should be so easy, but not for me, apparently!
I have a table of data that can be of varying lengths and widths. My current macro does what I want - up to a point; that being to transpose the data and paste it in a new group underneath the current data. But then I want to sort it and that's where my problem comes in. The new info will always be pasted into column AE, starting in the third row below the raw data. The last row of raw data is represented by "lr"; the last column of raw data is represented by "LC". Once the 2nd table is created, the last row of that data is represented by "LR2" and the last column is the new value for "LC".

I've tried NUMEROUS versions of that part of my code and get various different errors each time. It's just a SORT; it should not be this hard!! I feel stupid!
Anyway, if someone can point out what I'm doing wrong, it would make me very happy, then I could move on to the next part of the macro.

Here is the code as I have it right now. I'll Bold/Underline where the error messages appear:
VBA Code:
Sub MacroPOBI()
'JennyDrumm 082820
' MacroPOBI Macro

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

Cells.Select
With Selection
    .WrapText = False
    .MergeCells = False
    .Font.Name = "Times"
End With

Columns("AH:AH").Delete Shift:=xlLeft

lr = Cells(Rows.count, 31).End(xlUp).Row
LC = Cells(12, Columns.count).End(xlToLeft).Column

With Range(Cells(12, 31), Cells(lr, LC)).Select
    Selection.Copy
    Cells(lr + 2, 31).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End With

LC = Cells(lr + 2, Columns.count).End(xlToLeft).Column
LR2 = Cells(Rows.count, 31).End(xlUp).Row

[B][U]Range(lr + 2 & ":" & LC).Sort Key1:=Range("AF" & lr.Row + 2), Order:=xlAscending, Key2:= _
    Range("AG" & lr.Row + 2), Order:=xlAscending[/U][/B]

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With

End Sub


Here is what I have:

Capture1.JPG



Here is what I need:

Capture1b.JPG

Thank you for looking at this.

Jenny
 

Dossfm0q

Active Member
Joined
Mar 9, 2009
Messages
403
Hi Try this with out Last Column and your Feedback is highly Appreciated (y)

VBA Code:
Sub Macro1()
Dim Sht As Worksheet
Dim Rng As Range
Dim myRng As Range, SortRng As Range, ChrtRng As Range
Dim Arr As Variant
Dim R as long, C as long, N as long
Set Sht = ThisWorkbook.ActiveSheet
'Set Sht = ThisWorkbook.Worksheets("Name_of_sheet")

Set myRng = Sht.Range("AF12:AN12")
N = 0
R = myRng.Cells(1, 1).Row + 12
C = myRng.Cells(1, 1).Column

For Each Rng In myRng
If C - N = myRng.Cells(1, 1).Column Then
N = N + 1
Arr = Array("DC", "Store", "Total#" & Chr(10) & "Styles" & Chr(10) & "by Store", "Total#" & Chr(10) & "Units" & Chr(10) & "by Store", "Total#" & Chr(10) & "Units" & Chr(10) & "by Dc", "", "", "", "", "")
With Sht.Cells(R - N, C)
    .Value = Arr(N)
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

End If
    With Sht.Cells(R, C - N + 1)
        .Interior.Color = Rng.Interior.Color
    End With
   
    With Sht.Cells(R, C - N + 1 + 1)
        .Value = Rng.Offset(1, 0).Value
        .Interior.Color = Rng.Offset(1, 0).Interior.Color
    End With
   
    With Sht.Cells(R, C - N + 1 + 2)
        .Value = Rng.Offset(2, 0).Value
        .Interior.Color = Rng.Offset(2, 0).Interior.Color
   
    End With
   
    With Sht.Cells(R, C - N + 1 + 3)
        .Value = WorksheetFunction.Sum(Rng.Offset(3, 0).Resize(6, 1))
        .Interior.Color = Rng.Offset(3, 0).Resize(6, 1).Interior.Color
   
    End With


R = R + 1
C = C + 1

Next
Set ChrtRng = myRng.Cells(1, 1).Offset(12, 0).Resize(9, 5)
Set SortRng = myRng.Cells(1, 2).Offset(12, 0)

    Sht.Sort.SortFields.Clear
    Sht.Sort.SortFields.Add2 Key:=SortRng, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sht.Sort
        .SetRange ChrtRng
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub




Book1
ADAEAFAGAHAIAJAKALAMAN
12Styleunit1002/NP1006/AT1009/NB1010/LA1012/SF1014/WC1019/MA1020/BN7088/DIR
13707970997099707770777099709970997088
14100210061009101010121014101910207088
151758871288879
162708771087779
17365776977769
184708710777710
1953581089
20635871089
21
22
23StoreTotal# Styles by StoreTotal# Units by StoreTotal# Units by Dc
247088/DIR7077101061
251012/SF7077101246
261010/LA7079100247
271020/BN7088708855
281006/AT7099100629
291002/NP7099100927
301009/NB7099101429
311014/WC7099101929
321019/MA7099102027
Sheet2
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Dossfm0q

Active Member
Joined
Mar 9, 2009
Messages
403
Edit
Hi
if like this you want feed me back
VBA Code:
Sub Sort()

Dim Sht As Worksheet
Dim Rng As Range
Dim myRng As Range, SortRng As Range, ChrtRng As Range
Dim Arr As Variant
Dim R As Long, C As Long, N As Long
Set Sht = ThisWorkbook.ActiveSheet
''Set Sht = ThisWorkbook.Worksheets("Name_of_sheet")

Set myRng = Sht.Range("AF12:AN12")
N = 0
R = myRng.Cells(1, 1).Row + 12
C = myRng.Cells(1, 1).Column

For Each Rng In myRng
If C - N = myRng.Cells(1, 1).Column Then
N = N + 1
 Arr = Array("DC", "Store", "Total#" & Chr(10) & "Styles" & Chr(10) & "by Store", "Total#" & Chr(10) & "Units" & Chr(10) & "by Store", "Total#" & Chr(10) & "Units" & Chr(10) & "by Dc", "", "", "", "", "")
With Sht.Cells(R - N, C)
    .Value = Arr(N - 1)
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

End If
    With Sht.Cells(R, C - N + 1)
        .Interior.Color = Rng.Interior.Color
    End With
    
    With Sht.Cells(R, C - N + 1 + 1)
        .Value = Rng.Offset(1, 0).Value
        .Interior.Color = Rng.Offset(1, 0).Interior.Color
    End With
    
    With Sht.Cells(R, C - N + 1 + 2)
        .Value = Rng.Offset(2, 0).Value
        .Interior.Color = Rng.Offset(2, 0).Interior.Color
    
    End With
    
    With Sht.Cells(R, C - N + 1 + 3)
        .Value = WorksheetFunction.Sum(Rng.Offset(3, 0).Resize(6, 1))
        .Interior.Color = Rng.Offset(3, 0).Resize(6, 1).Interior.Color
    
    End With
    With Sht.Cells(R, C - N + 1 + 4)
 
        .Value = Evaluate("SUMPRODUCT(" & myRng.Cells(1, 1).Offset(3, 0).Resize(6, myRng.Columns.Count).Address & "*(" & myRng.Cells(1, 1).Offset(1, 0).Resize(1, myRng.Columns.Count).Address & "=" & Rng.Offset(1, 0).Address & "))")
        .Interior.Color = Rng.Offset(3, 0).Resize(6, 1).Interior.Color
    
    End With


 R = R + 1
C = C + 1

Next
Set ChrtRng = myRng.Cells(1, 1).Offset(12, 0).Resize(9, 5)
Set SortRng = myRng.Cells(1, 2).Offset(12, 0)

    Sht.Sort.SortFields.Clear
    Sht.Sort.SortFields.Add2 Key:=SortRng, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sht.Sort
        .SetRange ChrtRng
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub



Book1.xlsm
ADAEAFAGAHAIAJAKALAMAN
12Styleunit1002/NP1006/AT1009/NB1010/LA1012/SF1014/WC1019/MA1020/BN7088/DIR
13707970997099707770777099709970997088
14100210061009101010121014101910207088
151758871288879
162708771087779
17365776977769
184708710777710
1953581089
20635871089
21
22
23DCStoreTotal# Styles by StoreTotal# Units by StoreTotal# Units by Dc
241009/NB7077101061107
251006/AT7077101246107
261014/WC707910024747
271002/NP708870885555
281012/SF7099100629141
291019/MA7099100927141
301020/BN7099101429141
317088/DIR7099101929141
321010/LA7099102027141
Sheet2
 

zookeepertx

Active Member
Joined
May 27, 2011
Messages
480
Hello again!

Range(Cells(lr + 2, "AF"), Cells(LR2, LC)).Sort Key1:=Range("AF" & lr + 2), Order1:=xlAscending, Key2:= _ Range("AG" & lr + 2), Order2:=xlAscending

This is from the last revision you suggested yesterday - the one that ALMOST worked completely. I made 2 small changes to it and now it seems to work perfectly! The "Range(Cells(lr +2, " had it including the header row in the results into the sort, so I changed it to lr + 3. That way it leaves the header as is and just sorts the data. The , "AF") had it sorting without using the data in AE, so I just changed that to AE so that that column gets included in the sort.
Here's the final code, in case you want to see it:

VBA Code:
Sub POBI()
'MacroPOBI Macro

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

Cells.Select
With Selection
    .WrapText = False
    .MergeCells = False
    .Font.Name = "Times"
End With

Columns("AH:AH").Delete Shift:=xlLeft

lr = Cells(Rows.count, 31).End(xlUp).Row
LC = Cells(12, Columns.count).End(xlToLeft).Column

With Range(Cells(12, 31), Cells(lr, LC)).Select
    Selection.Copy
    Cells(lr + 2, 31).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End With

LC = Cells(lr + 3, Columns.count).End(xlToLeft).Column
LR2 = Cells(Rows.count, 31).End(xlUp).Row

Range(Cells(lr + 3, "AE"), Cells(LR2, LC)).Sort Key1:=Range("AF" & lr + 2), Order1:=xlAscending, Key2:= _
   Range("AG" & lr + 2), Order2:=xlAscending

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With

End Sub

Now it works exactly as needed! YAY!! This makes me so happy! You're awesome for hanging in with me for so long and for coming up with just what was needed! Thank you, thank you!

Thank you.jpg


Jenny
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,441
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
You're welcome

had it including the header row in the results into the sort, so I changed it to lr + 3. That way it leaves the header as is and just sorts the data

You could also have done ;)
Rich (BB code):
Range(Cells(lr + 2, "AE"), Cells(LR2, LC)).Sort Key1:=Range("AF" & lr + 2), Order1:=xlAscending, Key2:= _
   Range("AG" & lr + 2), Order2:=xlAscending, Header:=xlYes
 

zookeepertx

Active Member
Joined
May 27, 2011
Messages
480

ADVERTISEMENT

That's true, but I was stressed and couldn't think of the syntax right then and was tired of googling stuff, LOL!
 

zookeepertx

Active Member
Joined
May 27, 2011
Messages
480
Edit
Hi
if like this you want feed me back
VBA Code:
Sub Sort()

Dim Sht As Worksheet
Dim Rng As Range
Dim myRng As Range, SortRng As Range, ChrtRng As Range
Dim Arr As Variant
Dim R As Long, C As Long, N As Long
Set Sht = ThisWorkbook.ActiveSheet
''Set Sht = ThisWorkbook.Worksheets("Name_of_sheet")

Set myRng = Sht.Range("AF12:AN12")
N = 0
R = myRng.Cells(1, 1).Row + 12
C = myRng.Cells(1, 1).Column

For Each Rng In myRng
If C - N = myRng.Cells(1, 1).Column Then
N = N + 1
Arr = Array("DC", "Store", "Total#" & Chr(10) & "Styles" & Chr(10) & "by Store", "Total#" & Chr(10) & "Units" & Chr(10) & "by Store", "Total#" & Chr(10) & "Units" & Chr(10) & "by Dc", "", "", "", "", "")
With Sht.Cells(R - N, C)
    .Value = Arr(N - 1)
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

End If
    With Sht.Cells(R, C - N + 1)
        .Interior.Color = Rng.Interior.Color
    End With
   
    With Sht.Cells(R, C - N + 1 + 1)
        .Value = Rng.Offset(1, 0).Value
        .Interior.Color = Rng.Offset(1, 0).Interior.Color
    End With
   
    With Sht.Cells(R, C - N + 1 + 2)
        .Value = Rng.Offset(2, 0).Value
        .Interior.Color = Rng.Offset(2, 0).Interior.Color
   
    End With
   
    With Sht.Cells(R, C - N + 1 + 3)
        .Value = WorksheetFunction.Sum(Rng.Offset(3, 0).Resize(6, 1))
        .Interior.Color = Rng.Offset(3, 0).Resize(6, 1).Interior.Color
   
    End With
    With Sht.Cells(R, C - N + 1 + 4)

        .Value = Evaluate("SUMPRODUCT(" & myRng.Cells(1, 1).Offset(3, 0).Resize(6, myRng.Columns.Count).Address & "*(" & myRng.Cells(1, 1).Offset(1, 0).Resize(1, myRng.Columns.Count).Address & "=" & Rng.Offset(1, 0).Address & "))")
        .Interior.Color = Rng.Offset(3, 0).Resize(6, 1).Interior.Color
   
    End With


R = R + 1
C = C + 1

Next
Set ChrtRng = myRng.Cells(1, 1).Offset(12, 0).Resize(9, 5)
Set SortRng = myRng.Cells(1, 2).Offset(12, 0)

    Sht.Sort.SortFields.Clear
    Sht.Sort.SortFields.Add2 Key:=SortRng, _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sht.Sort
        .SetRange ChrtRng
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub



Book1.xlsm
ADAEAFAGAHAIAJAKALAMAN
12Styleunit1002/NP1006/AT1009/NB1010/LA1012/SF1014/WC1019/MA1020/BN7088/DIR
13707970997099707770777099709970997088
14100210061009101010121014101910207088
151758871288879
162708771087779
17365776977769
184708710777710
1953581089
20635871089
21
22
23DCStoreTotal# Styles by StoreTotal# Units by StoreTotal# Units by Dc
241009/NB7077101061107
251006/AT7077101246107
261014/WC707910024747
271002/NP708870885555
281012/SF7099100629141
291019/MA7099100927141
301020/BN7099101429141
317088/DIR7099101929141
321010/LA7099102027141
Sheet2

Hi there!
Thanks for your suggestion! I was able to adapt the previous code to get it to work, but I appreciate you looking at it.

Jenny
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
13,441
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile

ADVERTISEMENT

but I was stressed and couldn't think of the syntax right then
Know the feeling, Btw you should also change the other 2's to 3's
Rich (BB code):
Range(Cells(lr + 3, "AE"), Cells(LR2, LC)).Sort Key1:=Range("AF" & lr + 2), Order1:=xlAscending, Key2:= _
   Range("AG" & lr + 2), Order2:=xlAscending
 

Dossfm0q

Active Member
Joined
Mar 9, 2009
Messages
403
By Using Formula New

Book1.xlsm
ADAEAFAGAHAIAJAKALAMANAO
12Styleunit1002/NP1006/AT1009/NB1010/LA1012/SF1014/WC1019/MA1020/BN7088/DIR
13707970997099707770777099709970997088
14100210061009101010121014101910207088
151758871288879
162708771087779
17365776977769
184708710777710
1953581089
20635871089
21
22
23DCStoreTotal# Styles by StoreTotal# Units by StoreTotal# Units by DcUsing Formlua
241010/LA7077101061 
251012/SF7077101246107
261002/NP707910024747
277088/DIR708870885555
281006/AT7099100629 
291009/NB7099100927 
301014/WC7099101429 
311019/MA7099101929 
321020/BN7099102027141
33
Sheet2
Cell Formulas
RangeFormula
AF24:AF32AF24=INDEX($12:$12,AGGREGATE(15,6,COLUMN($AF$12:$AN$12)/($AF$13:$AN$13=AG24),COUNTIF(AG$24:AG24,AG24)))
AG24:AG32AG24=AGGREGATE(15,6,$AF$13:$AN$13,ROWS($AG$24:AG24))
AH24:AH32AH24=INDEX($14:$14,AGGREGATE(15,6,COLUMN($AF$14:$AN$14)/($AF$13:$AN$13=AG24),COUNTIF(AG$24:AG24,AG24)))
AI24:AI32AI24=SUM(IFERROR((AG24=$AF$13:$AN$13)/(AH24=$AF$14:$AN$14)*$AF$15:$AN$20,""))
AJ32,AJ24:AJ30AJ24=IF(COUNTIF($AG$24:$AG$32,AG24)=COUNTIF($AG$24:AG24,AG24),SUM(IFERROR((AG24=$AF$13:$AN$13)*$AF$15:$AN$20,"")),"")
AJ31AJ31=IF(COUNTIF($AG$24:$AG$32,AG31)=COUNTIF($AG$24:AG31,AG31),SUM(IFERROR((AG31=$AF$13:$AN$13)*$AF$15:$AN$20,"")),"")
Press CTRL+SHIFT+ENTER to enter array formulas.
Cells with Conditional Formatting
CellConditionCell FormatStop If True
AG33:AJ33Expression=$AF$33="7088/DIR"textNO
AG33:AJ33Expression=OR($AF$33="1010/LA",$AF$33="1012/SF")textNO
 

Dossfm0q

Active Member
Joined
Mar 9, 2009
Messages
403
Using VBA

add missing line now Ok
Sub SortKillingMe()
Dim Sht As Worksheet
Dim Rng As Range
Dim myRng As Range, SortRng As Range, ChrtRng As Range
Dim Arr As Variant
Dim R As Long, C As Long, N As Long
'Set Sht = ThisWorkbook.ActiveSheet
Set Sht = ThisWorkbook.Worksheets("Sheet6")

Set myRng = Sht.Range("AF12:AN12")
N = 0
R = myRng.Cells(1, 1).Row + 12
C = myRng.Cells(1, 1).Column

For Each Rng In myRng
If C - N = myRng.Cells(1, 1).Column Then
N = N + 1
Arr = Array("DC", "Store", "Total#" & Chr(10) & "Styles" & Chr(10) & "by Store", "Total#" & Chr(10) & "Units" & Chr(10) & "by Store", "Total#" & Chr(10) & "Units" & Chr(10) & "by Dc", "", "", "", "", "")
With Sht.Cells(R - N, C)
.Value = Arr(N - 1)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

End If
With Sht.Cells(R, C - N + 1 + 0)
.Value = Rng.Offset(0, 0).Value
.Interior.Color = Rng.Offset(0, 0).Interior.Color
End With
With Sht.Cells(R, C - N + 1 + 1)
.Value = Rng.Offset(1, 0).Value
.Interior.Color = Rng.Offset(1, 0).Interior.Color
End With

With Sht.Cells(R, C - N + 1 + 2)
.Value = Rng.Offset(2, 0).Value
.Interior.Color = Rng.Offset(2, 0).Interior.Color

End With

With Sht.Cells(R, C - N + 1 + 3)
.Value = WorksheetFunction.Sum(Rng.Offset(3, 0).Resize(6, 1))
.Interior.Color = Rng.Offset(3, 0).Resize(6, 1).Interior.Color

End With
With Sht.Cells(R, C - N + 1 + 4)

.Value = Evaluate("SUMPRODUCT(" & myRng.Cells(1, 1).Offset(3, 0).Resize(6, myRng.Columns.Count).Address & "*(" & myRng.Cells(1, 1).Offset(1, 0).Resize(1, myRng.Columns.Count).Address & "=" & Rng.Offset(1, 0).Address & "))")
.Interior.Color = Rng.Offset(3, 0).Resize(6, 1).Interior.Color

End With


R = R + 1
C = C + 1

Next
Set ChrtRng = myRng.Cells(1, 1).Offset(12, 0).Resize(9, 5)
Set SortRng = myRng.Cells(1, 2).Offset(12, 0)

Sht.Sort.SortFields.Clear
Sht.Sort.SortFields.Add2 Key:=SortRng, _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sht.Sort
.SetRange ChrtRng
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,114,509
Messages
5,548,484
Members
410,839
Latest member
MrSumo85
Top