Answered by:
move cells

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.
If this code does not satisfy your needs, please provide the further explanation or more sample rows.' --- [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
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/IUQUN2Tuesday, 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 !
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.
If this code does not satisfy your needs, please provide the further explanation or more sample rows.' --- [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
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