none
move cells RRS feed

  • Question

  • Hello Forum,

    I have the below tabel_1 and I want to make it like tabel_ 2 with VBA script  :

    tabel_1

    A

    B

    test

     

    <

    test1

    test2

     

    test   3

     

    >

    result1

    result2

     

    result3  

     

    <

    A

    >

    B

     

    tabel_2

    A

    B

    test

     

    <

    test1

     

    test2

     

    test   3

    >

    result1

     

    result2

     

    result3  

    <

    A

    >

    B

    Sub movecell()
    
    Dim mainMO As Worksheet
    Dim LastRow As Long
    Dim i As Integer
    
    Set mainMO = ActiveWorkbook.Sheets("Sheet1")
    LastRow = mainMO.Cells(mainMO.Rows.Count, "A").End(xlUp).Row
    
    For i = 1 To LastRow
    If mainMO.Cells(i, 1) = "<" & mainMO.Cells(i + 1, 1) <> ">" Then
    mainMO.Cells(i + 1, 1).Cut mainMO.Cells(i + 1, 2)
    
    ElseIf mainMO.Cells(i, 1) <> "<" & mainMO.Cells(i + 1, 1) = ">" Then
    mainMO.Cells(i, 1).Value = mainMO.Cells(i, 1).Value
    
    End If
    Next i
    End Sub
    

    I get not what I will , can anyone help please !

    Best regards ,


    • Edited by Req_En Tuesday, March 20, 2018 2:49 PM
    Tuesday, March 20, 2018 2:48 PM

Answers

  • Hi Req_En,

    I'm not sure if I can understand your requirement.
    But I made a sample from my guess.

        

    ' --- [Move Cells] Private Sub btn_MoveCells_Click() ' --- variables for row number Dim lastRow As Integer: lastRow = Cells(Rows.Count, 1).End(xlUp).Row Dim startRow As Integer: startRow = 0 Dim stopRow As Integer: stopRow = 0 ' --- variables for loop Dim myRow As Integer ' --- variables for check Dim IsDone As Boolean ' -- indicates if Cut&Paste has been done IsDone = False ' --- For-Next loop: Cut&Paste according to location of [<] [>] For myRow = 11 To lastRow - 1 ' --- check value ("<" or ">") Select Case Cells(myRow, 1).Value Case Is = "<" ' -- indicate start position If (IsDone = True) Then startRow = stopRow + 2 stopRow = myRow - 1 ' --- Cut & Paste Call prc_CutPaste(startRow, stopRow) IsDone = False Else startRow = myRow + 1 End If Case Is = ">" ' -- indicates stop position If (IsDone = True) Then MsgBox "myrow = " & myRow stopRow = myRow Else stopRow = myRow - 1 End If ' --- Cut & Paste Call prc_CutPaste(startRow, stopRow) IsDone = True End Select Next End Sub

    ' ---
    Private Sub prc_CutPaste(ByVal startRow As Integer, ByVal stopRow As Integer)
        Dim idx As Integer
        If (startRow < stopRow) Then
            For idx = startRow To stopRow
                Cells(idx, 2) = Cells(idx, 1).Value
                Cells(idx, 1).Value = ""
            Next
        End If
    End Sub
    If this code does not satisfy your needs, please provide the further explanation or more sample rows.

    Regards,

    Ashidacchi >> http://hokusosha.com/



    • Edited by Ashidacchi Thursday, March 22, 2018 1:41 AM
    • Marked as answer by Req_En Wednesday, June 6, 2018 8:09 AM
    Thursday, March 22, 2018 1:30 AM

All replies

  • I'm afraid you need to describe what you want to achieve in Sheet1.

    Ashidacchi >> http://hokusosha.com/

    Tuesday, March 20, 2018 4:35 PM
  • Req_En
    re:  code problems

    Maybe?...
    '---
    Sub movecell_R1()
      Dim mainMO As Worksheet
      Dim LastRow As Long
      Dim i As Integer
     
      Set mainMO = ActiveWorkbook.Sheets("Sheet1")
      LastRow = mainMO.Cells(mainMO.Rows.Count, "A").End(xlUp).Row
     
      For i = 1 To LastRow
      If VBA.Len(mainMO.Cells(i, 2).Value) < 1 And mainMO.Cells(i, 1).Value <> "test" Then
         mainMO.Cells(i, 1).Cut mainMO.Cells(i, 2)
      End If
      Next i
    End Sub
    '---
    Jim Cone
    https://goo.gl/IUQUN2
    Tuesday, March 20, 2018 5:30 PM
  • I want to cut the cells under ">" or under ">"and paste it in Col B !

    Wednesday, March 21, 2018 7:44 AM
  • I want to cut the cells under ">" or under ">"and paste it in Col B !

    Hi Req_En,

    I'm afraid you made typo. I guess the cells under ">" or under "<" is correct.

    Regards,

    Ashidacchi >> http://hokusosha.com/

    Wednesday, March 21, 2018 8:27 AM
  • Hi Req_En,

    I'm trying to make code... and get noticed that
    "<" indicates the start row and that
    "<" indicates the end row.
    (sorry my poor English)

    Anyway I hope you will provide a more clear or concrete description.

    Regards,

    Ashidacchi >> http://hokusosha.com/


    • Edited by Ashidacchi Wednesday, March 21, 2018 9:35 AM
    Wednesday, March 21, 2018 9:32 AM
  • Hi Req_En,

    If it is hard to describe/explain more, please increase sample rows of both table_1 and table_2.
    That will help me to understand your requirements.

    Regards,  

    Ashidacchi >> http://hokusosha.com/

    Wednesday, March 21, 2018 11:43 PM
  • Hi Req_En,

    I'm not sure if I can understand your requirement.
    But I made a sample from my guess.

        

    ' --- [Move Cells] Private Sub btn_MoveCells_Click() ' --- variables for row number Dim lastRow As Integer: lastRow = Cells(Rows.Count, 1).End(xlUp).Row Dim startRow As Integer: startRow = 0 Dim stopRow As Integer: stopRow = 0 ' --- variables for loop Dim myRow As Integer ' --- variables for check Dim IsDone As Boolean ' -- indicates if Cut&Paste has been done IsDone = False ' --- For-Next loop: Cut&Paste according to location of [<] [>] For myRow = 11 To lastRow - 1 ' --- check value ("<" or ">") Select Case Cells(myRow, 1).Value Case Is = "<" ' -- indicate start position If (IsDone = True) Then startRow = stopRow + 2 stopRow = myRow - 1 ' --- Cut & Paste Call prc_CutPaste(startRow, stopRow) IsDone = False Else startRow = myRow + 1 End If Case Is = ">" ' -- indicates stop position If (IsDone = True) Then MsgBox "myrow = " & myRow stopRow = myRow Else stopRow = myRow - 1 End If ' --- Cut & Paste Call prc_CutPaste(startRow, stopRow) IsDone = True End Select Next End Sub

    ' ---
    Private Sub prc_CutPaste(ByVal startRow As Integer, ByVal stopRow As Integer)
        Dim idx As Integer
        If (startRow < stopRow) Then
            For idx = startRow To stopRow
                Cells(idx, 2) = Cells(idx, 1).Value
                Cells(idx, 1).Value = ""
            Next
        End If
    End Sub
    If this code does not satisfy your needs, please provide the further explanation or more sample rows.

    Regards,

    Ashidacchi >> http://hokusosha.com/



    • Edited by Ashidacchi Thursday, March 22, 2018 1:41 AM
    • Marked as answer by Req_En Wednesday, June 6, 2018 8:09 AM
    Thursday, March 22, 2018 1:30 AM
  • Hello Ashidacchi,

    thank u for your code but I am afraid it did not work with my list!
    I have a big list with "<" and ">" and the distance between the two symbols is not always 2, it is variable.

    Best regards,

    Thursday, March 22, 2018 8:52 AM
  • Hi Req_En,

    Did you see my code?
    I imagine there would be more than two symbols, so I use "Select Case" (instead of "If Then Else").

    Anyhow, I'm afraid your explanation is insufficient and I cannot do more than that at this time.
    I hope you will provide a sample file that is more realistic than you provided before, or share it via cloud storage (e.g. OneDrive, Dropbox, etc.).
    If you provide your email address, I will send you an email. You can reply with an attached file.

    Remember to modify/edit your vital/personal data before providing or sharing.

    Regards,

    Ashidacchi >> http://hokusosha.com/

    Thursday, March 22, 2018 9:37 AM