Help with macro

Quote:

---

Originally Posted by mp_robinson_uk

Hi Jacob,

Another question if I may. I have modified the macro to do a bit more.

Code:

---

Columns(LastCol).Select
Selection.Sort Key1:=Range(LastCol), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Insert Shift:=xlToRight

---

The sort doesn't appear to work - well it sorts but then gives me an error

Runtime error 1004

Method Rang of object _Global failed

and does not do the next line of inserting the column.

Any ideas?

Thanks,

Mick

---

The Key1 part needs to be a single cell:

Code:

---

Key1:=Range(LastCol)

---

So we need to use Cells to assign one cell from the column:

Code:

---

Key1:=Range(Cells(1,LastCol).Address)

---

Also since these are formulas the column won't sort since the data for the formulas has not changed. You can sort all the data if you wanted instead of just the one column and leave the Key1 the same to sort by that column.

Hi Jacob,

Got it to sort correctly by changing to the cell as you suggested.

Thank you very much for all your help!

Thanks,

Mick

Hi All,

I thought I would post the complete code just in case it was ever off use to someone else. Thanks for all your help.

Thanks,

Mick :hi:

Code:

---

Option Explicit
 
Sub Add_Col_Row()
Dim LastRow As Long
    Dim LastCol As Long
    Dim i As Long
    Dim j As Long
    Dim Prompt          As String
    Dim Title          As String
    Dim Value          As Double
    Dim c              As Range
    Dim Counter        As Integer
Rows("1:1").Orientation = 90
    ActiveWindow.SplitRow = 1
    ActiveWindow.FreezePanes = True
    Cells.Columns.AutoFit
LastRow = Cells.Find(What:="*", LookIn:=xlValues, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
LastCol = Cells.Find(What:="*", LookIn:=xlValues, _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
For i = 5 To 6
        Range(Cells(LastRow, i).Address).Value = _
        "=Count(" & Cells(2, i).Address(False, False) & ":" & _
        Cells(LastRow - 1, i).Address(False, False) & ")"
    Next i
Range("E" & LastRow & ":F" & LastRow).AutoFill _
    Destination:=Range("E" & LastRow & ":" & _
    Cells(LastRow, LastCol - 1).Address(False, False)), Type:=xlFillDefault
For i = 2 To 3
        Cells(i, LastCol).Value = "=Min(" & Range("E" & i & _
        ":" & Cells(i, LastCol - 1).Address).Address(False, False) & ")"
    Next i
Range(Cells(2, LastCol).Address & ":" & Cells(3, LastCol).Address).AutoFill _
    Destination:=Range(Cells(2, LastCol).Address & ":" & _
    Cells(LastRow, LastCol).Address), Type:=xlFillDefault
For i = 2 To 3
        Cells(i, LastCol + 1).Value = "=Count(" & Range("E" & i & _
        ":" & Cells(i, LastCol - 1).Address).Address(False, False) & ")"
    Next i
Range(Cells(2, LastCol + 1).Address & ":" & Cells(3, LastCol + 1).Address).AutoFill _
    Destination:=Range(Cells(2, LastCol + 1).Address & ":" & _
    Cells(LastRow, LastCol + 1).Address), Type:=xlFillDefault
Cells(LastRow, LastCol + 1).ClearContents
    Cells(LastRow, LastCol).ClearContents
    Cells(1, LastCol + 1).Value = "number of corners with violations"
    Cells(1, LastCol).Value = "largest violations"
    Cells(LastRow, 2).Value = "number of violations per corner"
    Prompt = "Input the number that you want to add to each value."
    Title = "Number Input"
    Value = Val(InputBox(Prompt, Title))
  For Each c In Range(Cells(2, "E").Address & ":" & Cells(LastRow - 1, LastCol - 1).Address)
        If IsNumeric(c.Value) Then
            c.Value = c.Value + Value
        End If
        If c.Value >= 0 And IsNumeric(c.Value) Then
            c.ClearContents
        End If
    Next
  Counter = LastRow - 1
  Do While Counter > 1
    if Cells(Counter, LastCol).Value = 0 AND IsNumeric(Cells(Counter, LastCol)) Then
      Cells(Counter, LastCol).EntireRow.Delete
    End If
    Counter = Counter - 1
  Loop
    Columns(LastCol).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    Cells.Select
    Selection.Sort Key1:=Range(Cells(2,LastCol).Address), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Columns(LastCol).Select
    Selection.Insert Shift:=xlToRight
End Sub

---

Quote:

---

Originally Posted by mp_robinson_uk

Hi Jacob,

Got it to sort correctly by changing to the cell as you suggested.

Thank you very much for all your help!

Thanks,

Mick

---

You're Welcome

Take Care