Resize from i based on adjacent column value!

[sxhall]

I have a piece of code that I written that searches column O for a value of 1 and when found it checks the value in column N [offset(-1,-1)] to see if matches certain criteria. If does not then the range is resized to 6 rows cut and then pasted after the first example of a 6 is found in column N.

However When I have more than 6 rows it only moves these and does not go back to the original start point, in this case i!

I have tried both storing i as the start point and selecting it again but this has not worked. Have also tried adding in a count for the resize as the value in column is a "-" value. If I could count this I could use the value for my resize property. Whenever I have tried to do this I get stuck in a loop though!

My code so far is this...

Sub DynamicSort()

Dim ii As Integer
ii = 1

Range("O6:O74").Select

For Each i In Selection

If i = 1 Then

If i.Offset(-1, -1) <> 6 And i.Offset(-1, -1) <> "-" Then                  ' check performed in column N
     
i.Offset(0, -5).Select                                                     ' Selects cell in column J
Selection.Resize(6, 7).Cut                                                 ' Resizes from column J  *** Need to add a count from here until column N does not equal "-", 
                                                                           ' could use this number for resize value? Have tried a loop until range <>"-" but get stuck in a loop.

    i.Offset(0, -1).Select                                                 ' Moves to column N to search for the first instance of a 6 in the column to insert after
    Range(Selection, Selection.End(xlDown)).Select
    
On Error GoTo 999                                                          ' Error handler in case there is no 6 in the range
        
    Selection.Find(What:="6", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Select
        
    ActiveCell.Offset(1, -4).Select                                         ' Offset back to column J to insert cut data
    
    Selection.Insert Shift:=xlDown                                          ' *** or after doing this go back to where i was originally? ***

999

Else

End If

End If

Next

End Sub

The two lines indicated with a comment '***' are the places I have had trouble with. Annoying part is that my code moves the reference of i when I cut and paste and just picks up from where there not where i was originally!


Sample data...

|    Col I|    Col J|    Col K|    Col L|    Col M|   Col N|    Col O

|      Row|     Code|Indicator|Counter S|    S = 6|   C = 6|Counter C
______________________________________________________________________
|        1|       10|        S|        1|        1|        |        
|        2|       20|        S|        2|        2|        |        
|        3|       20|        S|        3|        3|        |        
|        4|       30|        S|        4|        4|        |        
|        5|       40|        C|         |        -|       1|        1
|        6|       40|        C|         |        -|       2|        2
|        7|       40|        C|         |        -|       3|        3
|        8|       40|        C|         |        -|       4|        4
|        9|       40|        C|         |        -|       5|        5
|       10|       40|        C|         |        -|       6|        6
|       11|       40|        C|         |        -|       1|        7
|       12|       40|        C|         |        -|       2|        8
|       13|       40|        C|         |        -|       3|        9
|       14|       40|        C|         |        -|       4|       10
|       15|       40|        C|         |        -|       5|       11
|       16|       40|        C|         |        -|       6|       12
|       17|       60|        S|        5|        5|        |       
|       18|       60|        S|        6|        6|        |       
|       19|       60|        S|        7|        1|        |       
|       20|       60|        S|        8|        2|        |

Columns L, M, N and O are aid columns to help me determine what needs to be moved and where to. Ultimately column M will be in groups of 6 as well as column N, below example.


Aiming for...

|    Col I|    Col J|    Col K|    Col L|    Col M|   Col N|    Col O

|    Index|     Code|Indicator|Counter S|    S = 6|   C = 6|Counter C
______________________________________________________________________
|        1|       10|        S|        1|        1|        |        
|        2|       20|        S|        2|        2|        |        
|        3|       20|        S|        3|        3|        |        
|        4|       30|        S|        4|        4|        |        
|       17|       60|        S|        5|        5|        |        
|       18|       60|        S|        6|        6|        |        
|        5|       40|        C|         |        -|       1|        1
|        6|       40|        C|         |        -|       2|        2
|        7|       40|        C|         |        -|       3|        3
|        8|       40|        C|         |        -|       4|        4
|        9|       40|        C|         |        -|       5|        5
|       10|       40|        C|         |        -|       6|        6
|       11|       40|        C|         |        -|       1|        7
|       12|       40|        C|         |        -|       2|        8
|       13|       40|        C|         |        -|       3|        9
|       14|       40|        C|         |        -|       4|       10
|       15|       40|        C|         |        -|       5|       11
|       16|       40|        C|         |        -|       6|       12
|       19|       60|        S|        7|        1|        |        
|       20|       60|        S|        8|        2|        |

You will see that rows 17 and 18 have been moved up completing a group of 6 in column M.

Currently my code reaches row 6 in the above performs well adding in the cut data below row 19 but then picks up from row 19, not 6.

If I could find an easy way of adding some sample data or an image I would to aid assistance. Am really hoping this make sense


Thanks for reading and thanks in advance for any assistance given.

Steven

 

[sxhall]

Replying to my own thread is odd but I figured a way to get around this. have added in my code, with all the other code included, below.

Feel free to critique or suggest a better/faster/expedient way of achieving the same as I'm always learning. But this works for me so i'm happy

Sub DynamicSort()

Dim RCount As String
Dim ii As Integer
ii = 1

Range("J6:P74").Select
    
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("J6"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("J6:P74")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Range("M6").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""S"",COUNTIF(R6C12:RC[-1],""S""),"""")"
    Range("N6").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]="""",""-"",IF(MOD(MAX(R6C13:RC[-1]),6)=0,6,MOD(MAX(R6C13:RC[-1]),6)))"
    Range("O6").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[1]="""","""",IF(MOD(MAX(RC16:R6C[1]),6)=0,6,MOD(MAX(RC16:R6C[1]),6)))"
    Range("P6").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-4]=""C"",COUNTIF(RC12:R6C[-4],""C""),"""")"
    
    Range("M6:P6").AutoFill Destination:=Range("M6:P" & Cells(Rows.Count, "J").End(xlUp).Row)
    Columns("M:P").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
    Range("J5:P5").AutoFilter
    ActiveSheet.Range("$J$5:$P$74").AutoFilter Field:=6, Criteria1:="="
    ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 6).Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.ClearContents
    
    ActiveSheet.Range("$J$5:$P$5").AutoFilter Field:=6

Range("O6:O74").Select

For Each i In Selection

If i = 1 Then

If i.Offset(-1, -1) <> 6 And i.Offset(-1, -1) <> "-" Then

    i.Select
    Range(Selection, Selection.End(xlDown)).Select
    RCount = Selection.Rows.Count

i.Offset(0, -5).Select
Selection.Resize(RCount, 7).Cut

    i.Offset(0, -1).Select
    Range(Selection, Selection.End(xlDown)).Select
    
On Error GoTo 999
        
    Selection.Find(What:="6", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False).Select
        
    ActiveCell.Offset(1, -4).Select
    
    Selection.Insert Shift:=xlDown
    
999

    Application.CutCopyMode = False
    
Else

End If

End If

Next

Application.CutCopyMode = False

End Sub

 

[Joe4]

Just a quick note. Here are a few things you can do to speed up your code:

1. Get rid of a lot of your Select statements. Most line that end with "Select" and the next line begins with "ActiveCell" or "Selection" can be combined into a single line. You usually do not need to select ranges to work with them, and doing so actually slows down the code.

So sections like this:

Range("O6:O74").Select

For Each i In Selection

can be simplified to this:

For Each i In Range("O6:O74")

And this:

Range("M6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""S"",COUNTIF(R6C12:RC[-1],""S""),"""")"

can be simplified to this:

Range("M6").FormulaR1C1 = "=IF(RC[-1]=""S"",COUNTIF(R6C12:RC[-1],""S""),"""")"

And this:

Range(Selection, Selection.End(xlDown)).Select

Selection.ClearContents

can be simplified to this:

Range(Selection, Selection.End(xlDown)).ClearContents

And temporarily disabling calculations and screen updating can also speed up your code.
Do that by placing this at the beginning of your code:

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

and then this at the end of the code:

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

 

[sxhall]

Thanks Joe,

Knowing how to reduce the lines in the examples above will be stored. Normally do disable the calculations and screen updating but this will be called as part of a bigger macro that has this built in already.