Complex Procedure

[Perdition]

Hi,

I have a complex procedure I'd like to do in a macro, and I'm having trouble getting it to work.

I work with contract management for support contracts. When I download a customer's contract information, the output file looks horrible, so I'm working on a macro to clean it up. I've already got it where it moves columns around and adds a filter, but there is more I'd like it to do.

When the data comes out, it's not sorted very well. I want to have the data sorted via three columns.

Column J is the end date, Column X is a unique identifier for each component of a configuration, Column C shows whether that component is the major line, or a minor line.

I've found the code that should do it, but it's not doing any actual sorting:

    With ActiveSheet.Sort
        With .SortFields
            .Clear
            .Add Key:=Range("J2:J" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("X2:X" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
            .Add Key:=Range("C2:C" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

I've already got LastRow defined elsewhere in the macro as the number of rows of data in the report.

But this is only step one. There may also be minor lines with different expiration dates, so I want to create a loop that will check each line to see if it is a major or minor line, if it's a minor line, I want it to check if the value in column X matches the value of the line above it, and if not, I;d like it to cut that line, find the correct value in column X, insert that cut line below the line it just found, then return to where it was and start again. I've started, but this just messes everything up:

    Dim Instance As String
    For i = 2 To LastRow
        If Range("C" & i).Value = "Minor" Then
            If Range("X" & i).Value <> Range("X" & i + 1).Value Then
                Instance = Range("X" & i).Value
                Rows(ActiveCell.Row).Cut
                Range("X2:X" & i).Find(What:=Instance).Select
                Rows(ActiveCell.Row).Insert shift:=xlShiftUp
                Application.CutCopyMode = False
            End If
        End If
    Next i

Any help would be appreciated.

 

[Fluff]

Hi & welcome to MrExcel
This should deal with the sorting (you missed 1 line)

With ActiveSheet.Sort
        With .SortFields
            .Clear
            .Add Key:=Range("J2:J" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=Range("X2:X" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
            .Add Key:=Range("C2:C" & lastrow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
       [COLOR=#ff0000] .SetRange Range("A2:X" & lastrow)[/COLOR]
        .header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

As for the 2nd part of your question, could you please explain what you're after, again?
As I'm not sure I understand

 

[Perdition]

Thanks! That line fixed the sorting issue.

So, the second part is this; after sorting, most of the configurations should be kept together, which was the point of the sorting in the first place. However, some items in a configuration may have different end dates from the major line, so I want to include code to find those and put them back with their configurations.

So, what I want it to do is check if the line is a minor line (column C). If it is a minor line, I want it to check the configuration identifier and see if it is the same as the one above it. If it isn't, then it must be one of the lines where its end date was different and needs to be moved. So, I want that line cut, then the macro needs to find the next instance of that identifier (which should be the major line) then insert the cut line from before under that line.

 

[Fluff]

Untested, but try

 Dim Instance As String
    For i = [COLOR=#ff0000]lastRow To 2 Step -1[/COLOR]
        If Range("C" & i).Value = "Minor" Then
            If Range("X" & i).Value <> Range("X" &[COLOR=#ff0000] i - 1[/COLOR]).Value Then
                Instance = Range("X" & i).Value
                Rows(ActiveCell.Row).Cut
                Range("X2:X" & i).Find(What:=Instance).Select
                Rows(ActiveCell.Row).Insert shift:=xlShiftUp
                Application.CutCopyMode = False
            End If
        End If
    Next i

2 changes in red

 

[Perdition]

This causes the same errors/issues.

1) I get an error saying "Runtime Error 1004 - This selection isn't valid. Make sure the copy and paste values don't overlap unless they are the same size and shape."

2) The header row I have gets moved down to row 2 and a row of date gets moved to row 1.

When I hit Debug, the highlighted line is:

Rows(ActiveCell.Row).Insert shift:=xlShiftUp

 

[Perdition]

I meant row of data gets moved, not row of date.

 

[Fluff]

Try this

    Dim Fnd As Range
    Dim Instance As String
    For i = lastRow To 2 Step -1
        If Range("C" & i).Value = "Minor" Then
            If Range("X" & i).Value <> Range("X" & i - 1).Value Then
                Instance = Range("X" & i).Value
                Rows(i).Cut
                Set Rng = Range("X2:X" & lastRow).Find(What:=Instance)
                If Not Rng Is Nothing Then Rows(Rng.Row + 1).Insert
                Application.CutCopyMode = False
            End If
        End If
    Next i

One word of warning, because you are moving rows around, you may need to run this more than once.
I'll have a think & see if I can come up with a better solution.