Resize from i based on adjacent column value!

sxhall

Board Regular
Joined
Jan 5, 2005
Messages
237
Office Version
  1. 365
Platform
  1. Windows
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...

Code:
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...

Code:
|    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...

Code:
|    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
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
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 :-)

Code:
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
 
Last edited:
Upvote 0
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:
Code:
Range("O6:O74").Select

For Each i In Selection
can be simplified to this:
Code:
For Each i In Range("O6:O74")

And this:
Code:
Range("M6").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""S"",COUNTIF(R6C12:RC[-1],""S""),"""")"
can be simplified to this:
Code:
Range("M6").FormulaR1C1 = "=IF(RC[-1]=""S"",COUNTIF(R6C12:RC[-1],""S""),"""")"

And this:
Code:
Range(Selection, Selection.End(xlDown)).Select

Selection.ClearContents
can be simplified to this:
Code:
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:
Code:
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
and then this at the end of the code:
Code:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
Last edited:
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,215
Members
452,618
Latest member
Tam84

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top