Results 1 to 4 of 4
  1. #1
    New Lounger
    Join Date
    May 2015
    Posts
    13
    Thanks
    5
    Thanked 0 Times in 0 Posts

    Move a row with Spin up & spin down - Skip rows containing a specific value

    hi experts,
    This code added below is letting me moving rows up and down when i select 1st cell defined in the code. So i avoid problems which could occur during cut&paste.

    I am trying to add a rule into my code. There is now some additional rows indicating as row headers; which i want to keep my 'movable' rows between them.

    If the first cell value of my movable row equals to the value of header rows cell, then i want to keep the movable row under the header. I just added a screenshot to be more clear.

    Any help with the core would be much appreciated.

    current.jpgTarget.jpg


    Code:
    Private Sub SpinButton1_SpinDown()
        Application.ScreenUpdating = False
        Dim ID(15), line As Integer
        line = ActiveCell.Row
        If line = 105 Then Exit Sub
        For i = 1 To 15
            ID(i) = Cells(line, i)
        Next i
        For i = 1 To 15
            Cells(line, i) = Cells(line, i).Offset(1, 0)
        Next i
        For i = 1 To 15
            Cells(line, i).Offset(1, 0) = ID(i)
        Next i
        Cells(line, i).Select
        Cells(line, 1).Offset(1, 2).Select
    Application.ScreenUpdating = True
    End Sub
    
    Private Sub SpinButton1_SpinUp()
    Application.ScreenUpdating = False
        Dim ID(15), line As Integer
        line = ActiveCell.Row
        If line = 9 Then Exit Sub
        For i = 1 To 15
            ID(i) = Cells(line, i)
        Next i
        For i = 1 To 15
            Cells(line, i) = Cells(line, i).Offset(-1, 0)
        Next i
        For i = 1 To 15
            Cells(line, i).Offset(-1, 0) = ID(i)
        Next i
        Cells(line, i).Select
        Cells(line, 1).Offset(-1, 2).Select
    Application.ScreenUpdating = True
    End Sub
    Last edited by lerq; 2016-01-20 at 13:33.

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,643
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Hi lerq,

    That seems so long ago. I used the file I posted from the original thread to make the revisions. See the changes in blue. The lines will not invade the header rows above or below them when moving them. You can adapt the changes to your sheet.

    Also, you will need to merge the cells in your headers to prevent moving them from moving. In my sample, I merged A4 with B4, A8 with B8, and A13 with B13 (all are first 2 cells of header rows)

    HTH,
    Maud

    Code:
    Private Sub SpinButton1_SpinDown()
    Application.ScreenUpdating = False
        Dim ID(14), line As Integer
        line = ActiveCell.row
    '---------------------------------
    'RULES ADDED
        If line = 41 Then Exit Sub
        Select Case line + 1
            Case 4, 8, 13 '4-8-13 HEADER ROWS CHANGE FOR THE ROWS OF YOUR HEADERS
                Exit Sub
        End Select
    '---------------------------------
    'PLACE ROW INTO ARRAY VARIABLE
        For I = 1 To 14 'CHANGE TO NUMBER OF COLUMNS
            ID(I) = Cells(line, I)
        Next I
    '---------------------------------
    'MOVE ROW BELOW TO CURRENT ROW
        For I = 1 To 14 'CHANGE TO NUMBER OF COLUMS
            Cells(line, I) = Cells(line, I).Offset(1, 0)
        Next I
    '---------------------------------
    'PLACE ARRAY VARIABLE TO ONE ROW DOWN
        For I = 1 To 14 'CHANGE TO NUMBER OF COLUMS
            Cells(line, I).Offset(1, 0) = ID(I)
        Next I
        Cells(line, I).Select
        Cells(line, 1).Offset(1, 0).Select
    Application.ScreenUpdating = True
    End Sub
    
    
    Private Sub SpinButton1_SpinUp()
    Application.ScreenUpdating = False
        Dim ID(14), line As Integer
        line = ActiveCell.row
    '---------------------------------
    'RULES ADDED
        If line = 2 Then Exit Sub
        Select Case line - 1
            Case 4, 8, 13 '4-8-13 HEADER ROWS CHANGE FOR THE ROWS OF YOUR HEADERS
                Exit Sub
        End Select
    '---------------------------------
    'PLACE ROW INTO ARRAY VARIABLE
        For I = 1 To 14 'CHANGE TO NUMBER OF COLUMS
            ID(I) = Cells(line, I)
        Next I
    '---------------------------------
    'MOVE ROW ABOVE TO CURRENT ROW
        For I = 1 To 14 'CHANGE TO NUMBER OF COLUMNS
            Cells(line, I) = Cells(line, I).Offset(-1, 0)
        Next I
    '---------------------------------
    'PLACE ARRAY VARIABLE TO ONE ROW UP
        For I = 1 To 14 'CHANGE TO NUMBER OF COLUMNS
            Cells(line, I).Offset(-1, 0) = ID(I)
        Next I
        Cells(line, I).Select
        Cells(line, 1).Offset(-1, 0).Select
    Application.ScreenUpdating = True
    End Sub
    Attached Files Attached Files
    Last edited by Maudibe; 2016-01-20 at 18:34.

  3. #3
    WS Lounge VIP
    Join Date
    Dec 2009
    Location
    Earth
    Posts
    8,207
    Thanks
    49
    Thanked 989 Times in 919 Posts
    Why doesn't is read like this?
    Code:
    'RULES ADDED
        Select Case line + 1
            Case 4, 8, 13, 42 '4-8-13-42 HEADER ROWS CHANGE FOR THE ROWS OF YOUR HEADERS
                Exit Sub
        End Select
    cheers, Paul

  4. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,643
    Thanks
    115
    Thanked 652 Times in 594 Posts
    Nice Paul...seems logical to me!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •