Solved

Excel VBA Array

Posted on 2013-11-20
26
612 Views
Last Modified: 2013-12-04
I am using VBA in Excel 2010 and have an array  called HeadingLocation defined with 11 locations (0-10). I have a loop filling the array locations with row values.

Now I want to select a range from one array position to another, eg:

Range ("A" & HeadingLocation(0) &  ":A" & HeadingLocation(1)).Select

As I loop around I want to change the array location to match the loop cycle, eg first loop array position 0 to 1, second loop position 2 to 3  etc.

I would appreciate help in getting the array locations to change on each loop, all my attempts are failing :(  Many thanks
0
Comment
Question by:nigelboyle
  • 14
  • 11
26 Comments
 
LVL 35

Expert Comment

by:mvidas
ID: 39663556
Hi Nigel,

Can you show the code you're using for the loop? You should be able to manipulate the counter variable mathematically, like:
Sub NBExample()
 Dim i As Long
 For i = 0 To 5
  MsgBox (i * 2 + 0) & " to " & (i * 2 + 1)
 Next
End Sub

Open in new window

That will show you "0 to 1" "2 to 3", etc, through "10 to 11".

If you want help adapting it to your case, feel free to paste in your code.
Matt
0
 
LVL 33

Expert Comment

by:Norie
ID: 39663743
You can use For with a step of 2.
For I = LBound(HeadingLocation) To UBound(HeadingLocation) Step 2
    Range ("A" & HeadingLocation(I) &  ":A" & HeadingLocation(I+1)).Select
    MsgBox Range ("A" & HeadingLocation(I) &  ":A" & HeadingLocation(I+1)).Address
Next I

Open in new window


PS It would be interesting to know what you are doing with the range(s) you are selecting.
0
 

Author Comment

by:nigelboyle
ID: 39664325
Thanks both, I will post my code in the morning. I may we take you up of the code help!

@imnorie  I see what you are saying, I tried with a variable called 'Header' I had put that in where you have 'I' and it was failing on me. I will try the single letter, perhaps that is what it needs.

This is what I am doing:  I have a table of data I am dividing by headers, and headerlocation is the row of the header. As I have this in place I want to blank the detail in the subsequent rows, hence needing the capture the range to the next header.
0
 

Author Comment

by:nigelboyle
ID: 39665480
Morning Matt and Imnorie.

I am stuck and would appreciate your offers of help. My code follows, most of it you can ignore as it is unrelated to the issue, but when you get down to the section:  'add header text '  you see my first problem:

HeadingLocation = ActiveCell.Row              ' problem one

As the code loops around this is writing to the same array position, overwriting the previous, rather than moving along the array. Do I need another loop to specify the position?

Problem two in the  'blank detail in rows'   section  ( may be caused by problem one!) I used your code (Imnorie) and it is erroring, I believe possibly because the array positions are empty, but perhaps you can see something else?

I will attach the code as a notepad file - seems best. If you need a sample spreadsheet please let me know - I will email mail it as it is too big to upload!

Hopefully for the cognoscenti it is only a little issue, but it kept me up overnight!

Many thanks    Nigel    Kill-Plan.txt
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39668828
Hi Nigel,

Sorry I didn't get back to you yesterday, had a long day and couldn't make the time to come help.
I think the reason Imnorie asked about what you're doing with selected ranges is because you don't need to select anything in your code for most processes (and it usually slows things down when you do, and looks cleaner). For example, instead of:
    Range("F" & Top & ":F" & Bottom).Select
    Selection.NumberFormat = "#,##0"

Open in new window

You could have just used:
    Range("F" & Top & ":F" & Bottom).NumberFormat = "#,##0"

Open in new window

I'm looking through your code and am cleaning it up right now. Shouldn't take too long.
Matt
0
 

Author Comment

by:nigelboyle
ID: 39668985
Thanks for you comment, better coding noted!   I appreciate your time on the problem, and look forward to receiving it as soon as you're able.

Thanks again.

Nigel
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39669102
Nigel,

Give the following a try, hopefully I've interpreted everything you were doing correctly. I changed your heading locations to be a dynamic count; it may be 11 headings now but who knows in the future. Better to be safe.
Sub Macro1()
    Dim Top As Long, Bottom As Long
    Dim HeadingLocation() As Double, HeadingNumber As Long
    Dim i As Long
    Dim CLL As Range
    
    Top = Range("StartNumber").Row + 1
    Bottom = Top - 1 + Range("_datarows").Value
   
    Range("AA1").Formula = "O" & Top
    Range("B3").Formula = "=INDIRECT(AA1)"
    
    Range("AB1").Formula = "A" & Top
    Range("WeekDate").Formula = "=INDIRECT(AB1)"

    Range("SumRange").Formula = "=sum(F" & Top & ":F" & Bottom & ")"
    Range("H" & Top & ":H" & Bottom).Insert Shift:=xlToRight
      
    ActiveWindow.DisplayZeros = False
    
    Range("I" & Top & ":J" & Bottom).NumberFormat = "#,##0.00"
    Range("F" & Top & ":F" & Bottom).NumberFormat = "#,##0"
    
    Range("A1:P1").UnMerge
        
    Columns("H").EntireColumn.Delete
    Columns("P").EntireColumn.Insert
    
    With Range("D" & Bottom + 5 & ":" & "F" & Bottom + 5)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Merge
    End With
       
    Range("B1").FormulaR1C1 = "Hook2Sisters Ltd                                      Kill Plan"
        
    With Range("B1:N1")
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Merge
    End With
    
    Range("A" & Top & ":A" & Bottom).NumberFormat = "ddd dd mmm"
    
    Range("A" & Top - 1).FormulaR1C1 = "Date"
    Range("D" & Top - 1).FormulaR1C1 = "Type"
    Columns("I").ColumnWidth = 10.86
    Range("M" & Top - 1).FormulaR1C1 = "COMMENTS"
    Range("N" & Top - 1).ClearContents
    With Range("M" & Top - 1 & ":N" & Top - 1)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Merge
    End With

' Creat righthand Table

    Range("R" & Top & ":R" & Bottom).FormulaR1C1 = "=+RC[-10]*RC[-12]"
    Range("S" & Top & ":S" & Bottom).FormulaR1C1 = "=IF(RC[-12]=R14C19,RC[-11],"""")"
    Range("T" & Top & ":T" & Bottom).FormulaR1C1 = "=IF(RC[-13]=R14C20,RC[-12],"""")"
    Range("U" & Top & ":U" & Bottom).FormulaR1C1 = "=IF(RC[-14]=R14C21,RC[-13],"""")"
    Range("V" & Top & ":V" & Bottom).FormulaR1C1 = "=IF(RC[-15]=R14C22,RC[-14],"""")"
    Range("W" & Top & ":W" & Bottom).FormulaR1C1 = "=IF(RC[-16]=R14C23,RC[-18],"""")"
    Range("X" & Top & ":X" & Bottom).FormulaR1C1 = "=IF(RC[-17]=R14C24,RC[-19],"""")"
    Range("Y" & Top & ":Y" & Bottom).FormulaR1C1 = "=IF(RC[-18]=R14C25,RC[-20],"""")"
    Range("Z" & Top & ":Z" & Bottom).FormulaR1C1 = "=IF(RC[-19]=R14C26,RC[-21],"""")"
    Range("F5:F11").Delete Shift:=xlToLeft
   
'Aveerages
      
    Range("S" & Top - 2 & ":Z" & Top - 2).FormulaR1C1 = _
     "=IFERROR(SUM(R" & Top & "C:R" & Bottom & "C)/COUNT(R" & Top & "C:R" & Bottom & "C),"""")"
     
    'Create Top Table
     
    'Quantities
    Range("F5:F8").FormulaR1C1 = "=SUMIF(R" & Top & "C[1]:R" & Bottom & "C[1],RC[-3],R" & Top & "C:R" & Bottom & "C)"
     
    'Averages
      
    Range("G5").FormulaR1C1 = "=+R[10]C[14]"
    Range("G6").FormulaR1C1 = "=+R[9]C[15]"
    Range("G7").FormulaR1C1 = "=+R[8]C[12]"
    Range("G8").FormulaR1C1 = "=+R[7]C[13]"
    
    Range("H5").FormulaR1C1 = "=+R[10]C[17]"
    Range("H6").FormulaR1C1 = "=+R[9]C[18]"
    Range("H7").FormulaR1C1 = "=+R[8]C[15]"
    Range("H8").FormulaR1C1 = "=+R[7]C[16]"
    
    Range("F10").FormulaR1C1 = "=+R[-5]C+R[-3]C"
    Range("F11").FormulaR1C1 = "=+R[-5]C+R[-3]C"
    
    'Tidy
    Range("A1").ClearContents
    Columns("Q").EntireColumn.Insert
    Columns("Q").EntireColumn.Insert
    Columns("Q").EntireColumn.Insert
    Columns("Q").EntireColumn.Insert
    
    With Range("P:P,Q1:U19").Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("F14").ClearContents
       
    Range("F3:F4").Delete Shift:=xlToLeft
    
    Columns("G").ColumnWidth = 7.71
    Columns("B").ColumnWidth = 17.71
    
    Range("N18:N" & Bottom).Borders.LineStyle = xlNone
    Range("F8").Font.Bold = False
    
    'Sort
    Range("A16:N" & (Cells(Rows.Count, 1).End(xlUp).Row)).Sort _
        Key1:=Range("A17"), Order1:=xlAscending, DataOption1:=xlSortNormal, _
        Key2:=Range("B17"), Order2:=xlAscending, DataOption2:=xlSortNormal, _
        Key3:=Range("C17"), Order3:=xlAscending, DataOption3:=xlSortTextAsNumbers, _
        Header:=xlYes, MatchCase:=False, SortMethod:=xlPinYin
     
    'SubTotal
    Range("E17").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(6), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    
    'Print Area
'    Range("A" & Top & ":N" & (Range("PrintCorner").Row - 1)).Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintArea = "$A$1:$N$32"
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True

'Set headings
    Range("P" & Top).Resize(11, 1).FormulaR1C1 = "=IF(RIGHT(RC[-15],5)=""Total"",""Total"","""")"
    Range("Q" & Top).Resize(11, 1).FormulaR1C1 = _
        "=IF(R[-1]C[-16]=""Date"",""Yes"",IF(RC[-16]=""Grand Total"",""No"",IF(AND(R[-1]C[-1]=""Total"",RC[-16]=R[1]C[-16]),""Yes"",""No"")))"

    'loop to find and insert headings
    Bottom = Range("printcorner").Row
    ReDim HeadingLocation(0)
    HeadingNumber = 0
    
    For Each CLL In Range("Q" & Top & ":Q" & Bottom).Cells
        If CLL.Value = "Yes" Then
            If CLL.Row = Range("printcorner").Row Then Exit For
            CLL.EntireRow.Insert Shift:=xlDown
            'add heading text
            With Intersect(CLL.EntireRow, Columns("A")).Offset(-1, 0)
                .Offset(1, 0).Copy Destination:=.Cells(1, 1)
                .NumberFormat = "dddd dd mmmm"
                With .Resize(1, 4)
                    .Merge
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                    With .Font
                        .Bold = True
                        .Name = "Calibri"
                        .Size = 12
                        .Strikethrough = False
                        .Superscript = False
                        .Subscript = False
                        .OutlineFont = False
                        .Shadow = False
                        .Underline = xlUnderlineStyleNone
                        .ThemeColor = xlThemeColorLight1
                        .TintAndShade = 0
                        .ThemeFont = xlThemeFontMinor
                    End With
                End With
                ReDim Preserve HeadingLocation(HeadingNumber)
                HeadingLocation(HeadingNumber) = .Row
                HeadingNumber = HeadingNumber + 1
            End With
        End If
    Next
  
    For i = LBound(HeadingLocation) To UBound(HeadingLocation) Step 2
        With Range("A" & HeadingLocation(i) & ":A" & HeadingLocation(i + 1) - 1).Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
    Next i
End Sub

Open in new window

Give it a try, and let me know how it went!
Matt
0
 

Author Comment

by:nigelboyle
ID: 39669231
Hi Matt

Many thanks for quickly doing this.  I am really grateful as it is needed for Monday. I am sure if there is a misinterpretation I will be able to change it now you have the syntax etc for me.

Unfortunately due to another issue I only got 2 hours sleep last night so am heading home.  I will look over the weekend  and let you know,

Amazing service Matt, appreciated :)
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39669254
I should be around through much of the weekend, though maybe not immediately, so I'll be there if you need it.
0
 

Author Comment

by:nigelboyle
ID: 39677291
Hi Matt. The weekend work didn't happen! Thanks for the offer.  

I am running your code and in the Create Headers section the following happens:

The first 'Yes' is found, a row inserted and the header written, it then loops through several 'No's and comes to the next 'Yes', another row is inserted and the header created. It then goes wrong in that it stops stepping down the list and continually adds a new row at the point of the second 'Yes'.

Unfortunately I don't understand you code so can't work out where it is failing.

As ever I appreciate your help

Nigel
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39680681
That is puzzling. Any way you can post a sample workbook?

If you can't due to sensitive info, you could try adding this middle line here to the end of the Create Headers loop (the first and last 2 lines are for reference):
                HeadingNumber = HeadingNumber + 1
            End With
            Set CLL = CLL.Offset(1, 0) 
        End If
    Next

Open in new window

If you ever did have two "Yes" cells in a row, that would skip the second one. A sample book would be best though so I could figure out exactly why.
0
 

Author Comment

by:nigelboyle
ID: 39680702
Hi Matt, Happy to post as sample,here goes, it may be too big.....

Many thanks :)
Integra0.xls
0
 

Author Comment

by:nigelboyle
ID: 39680703
Happily not too big :)
0
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 
LVL 35

Expert Comment

by:mvidas
ID: 39680888
I must say, I have no idea why it is doing that. It defies logic.

But, at least it is consistently doing it wrong; we can just change our programming logic. I made a few changes (and including to the For loop this question was originally about, for when there are an odd number of headings). Replace the end of the code with this (first line comment for reference):
    'loop to find and insert headings
    Bottom = Range("printcorner").Row
    ReDim HeadingLocation(0)
    HeadingNumber = 0
    
    Dim bRow As Range
    Set bRow = Range("Q" & Bottom)
    Set CLL = Range("Q" & Top)
    Do
        If CLL.Value = "Yes" Then
            If CLL.Row = Range("printcorner").Row Then Exit Do
            CLL.EntireRow.Insert Shift:=xlDown
            'add heading text
            With Intersect(CLL.EntireRow, Columns("A")).Offset(-1, 0)
                .Offset(1, 0).Copy Destination:=.Cells(1, 1)
                .NumberFormat = "dddd dd mmmm"
                With .Resize(1, 4)
                    .Merge
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                    With .Font
                        .Bold = True
                        .Name = "Calibri"
                        .Size = 12
                        .Strikethrough = False
                        .Superscript = False
                        .Subscript = False
                        .OutlineFont = False
                        .Shadow = False
                        .Underline = xlUnderlineStyleNone
                        .ThemeColor = xlThemeColorLight1
                        .TintAndShade = 0
                        .ThemeFont = xlThemeFontMinor
                    End With
                End With
                ReDim Preserve HeadingLocation(HeadingNumber)
                HeadingLocation(HeadingNumber) = .Row
                HeadingNumber = HeadingNumber + 1
            End With
        End If
        If Intersect(CLL.EntireRow, Columns("A")).Value = "Grand Total" Then
            Set bRow = CLL.Offset(-1, 0)
            Exit Do
        End If
        If CLL.Address = bRow.Address Then Exit Do
        Set CLL = CLL.Offset(1, 0)
    Loop
  
    For i = LBound(HeadingLocation) To UBound(HeadingLocation) Step 2
        If i = UBound(HeadingLocation) Then
            With Range("A" & HeadingLocation(i) & ":A" & bRow.Row).Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        Else
            With Range("A" & HeadingLocation(i) & ":A" & HeadingLocation(i + 1) - 1).Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        End If
    Next i
End Sub

Open in new window

Should do the trick!
Matt
0
 

Author Comment

by:nigelboyle
ID: 39680897
Humans are very good at defying logic, but rarely programs!

Many thanks I will have a go.
0
 

Author Comment

by:nigelboyle
ID: 39681119
Hi Matt   Very nearly there, many thanks.

The next loop - blanking the in between data.  I had to add +1 in the range as it was blanking the header too, but it is not looping and only blanking the first data range.  sample attached.

I'm nearly ready to let you go!   Thanks again
integra8.bmp
Integra8.pdf
0
 
LVL 35

Accepted Solution

by:
mvidas earned 500 total points
ID: 39681166
As for the error above, once again the old joke proves true: "I hate it when computers do what I tell it to, and not what I want it to." Rorya (a fellow expert here) explained to me why the original code didn't work; it wasn't defying logic, I just misunderstood the logic. :)

Perhaps I misunderstood your original idea. Do you want every block of dates under the headers blanked? I thought you were just alternating them for some reason. (like blanking 0 to 1, 2 to 3, 4 to 5, instead of 0 to 1, 1 to 2, 2 to 3)

Just get rid of the "Step 2" and you'll be all set:
    For i = LBound(HeadingLocation) To UBound(HeadingLocation)
        If i = UBound(HeadingLocation) Then
            With Range("A" & HeadingLocation(i) + 1 & ":A" & bRow.Row).Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        Else
            With Range("A" & HeadingLocation(i) + 1 & ":A" & HeadingLocation(i + 1) - 1).Font
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = 0
            End With
        End If
    Next i

Open in new window

EDIT: added +1 after headinglocation(i)
0
 

Author Comment

by:nigelboyle
ID: 39683165
Hi Matt, crossing with your post I walked through the macro and had just removed the Step 2 myself.  I logged in here to tell you all is working perfectly and to thank you for all this work.

Co-incidence that your post was here when I arrived.

I really appreciated both your work and the lessons Matt.  I would love to send a personal thank you if you dare post an email addy on here :)

Warmest appreciation from England.

Nigel
0
 

Author Closing Comment

by:nigelboyle
ID: 39683166
Work beyond the call of duty!
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39683241
No additional thanks are needed, I just enjoy helping. I'm glad it's running smoothly now! Let me know if you need anything else.

Matt
0
 

Author Comment

by:nigelboyle
ID: 39683848
Hi Matt

Sorry one further snippet please:

I need to step down a column and if there is any text replace is with "Salmonella"

This is not right I know, but my knowledge is lacking!

Many Thanks


' Salmonela

   Set Salm = Range("M" & Top)
   Set SalmValue = "Salmonella"
    Do
               
        If Salm.Value <> "" Then
            If Salm.Row = Range("printcorner").Row Then Exit Do
            Salm = SalmValue.Value
           
        End If
       
        Salm = Salm + 1
    Loop
     
            Exit Do
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39689937
Sorry about the wait, I went away for the holiday weekend, and played catch up at home yesterday.

For something like this, there is no need to step through the column. You can just use the find/replace function, and search for "*" (which is a wildcard for anything):
Range("M" & Top & ":M" & Range("printcorner").Row).Replace What:="*", Replacement:="Salmonella"

Open in new window

0
 

Author Comment

by:nigelboyle
ID: 39689951
Not a problem, I trust you had a good break. Many thanks for this Matt. If I need any more I will post as a new question (thinking for your points!)

Nigel
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39690012
Don't worry about my points, I have very little motivation for them; as long as I answer 2 questions in a month I'm set for my points. A separate question could help you look back later though to help you organize the info.

If you do start a new question and aren't getting anywhere with it, you can feel free to email me with a link, my email address should be in my profile.
0
 

Author Comment

by:nigelboyle
ID: 39692190
Your Replace section works perfectly, thanks Matt.  Beginning to realize how much I don't know about excel!

All is running well but I do get an Excel warning when it starts the sort. attached are the two warnings.  If you say OK to both the sort works, is there any way of suppressing these?

Thanks

Nigel
warnings.docx
0
 
LVL 35

Expert Comment

by:mvidas
ID: 39696052
Hmm, too bad. We'll have to go back to the old method I guess, the way you had before. Replace the .Sort block with this
    Bottom = Cells(Rows.Count, 1).End(xlUp).Row
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A17:A" & Bottom) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("B17:B" & Bottom) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("C17:C" & Bottom) _
        , SortOn:=xlSortTextAsNumbers, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("A17:N" & Bottom)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Open in new window

0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

This very simple solution applies to a narrow cross-section of the "needs to close" variety. In this case, the full message in Event Viewer was in applog, Event ID 1000: Faulting application iexplore.exe, version 8.0.6001.18702, faulting module …
As with any other System Center product, the installation for the Authoring Tool can be quite a pain sometimes. This article serves to help you avoid making these mistakes and hopefully save you a ton of time on troubleshooting :)  Step 1: Make sur…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now