if there is repetition, copy and move VBA

[spasmex97]

I have a data set which is in Column A and something like this

47652499_ASM\14078000.stp

47652499_ASM\47652452.stp

47652499_ASM\47652453.stp

and i would like to move that part after "\" and want to see it like

47652499_ASM\14078000.stp

14078000.stp

47652452.stp

47652453.stp

but data set could be way longer and repetitions can various from 2 to 10 or more
i think it would like to hold the (i,j) value and then compare it with (i+1,j) and so on until there is no match then hold the new cell's value and repeat, but i have lack of excel skills so i am looking for your help guys, thank you in advance

 

[spasmex97]

That error should be completely unrelated to your Excel version.
However, what line of the code causes the error?

  b(k, 1) = a(i, 1) & ";" & Bits(1)

 

[Peter_SSs]

Thanks. That certainly confirms that the error is unrelated to version.
If that error happens all the time then can you post (with XL2BB) a small set of sample data that causes the error?
Also, can you post the actual vba code that you are using so that we can just check in case something has been changed and might cause that error?

 

[spasmex97]

Thanks. That certainly confirms that the error is unrelated to version.
If that error happens all the time then can you post (with XL2BB) a small set of sample data that causes the error?
Also, can you post the actual vba code that you are using so that we can just check in case something has been changed and might cause that error?

dosya yolu olusturma makro - Kopya -2.xlsm
	A	B	C
1	Extension	Birleştirilmiş.1.1	Birleştirilmiş
2	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652433\47652433.stp
3	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652437\47652437.stp
4	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652441\47652441.stp
5	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652446\47652446.stp
6	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652447\47652447.stp
7	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652499_ASM\14078000.stp
8	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652499_ASM\47652452.stp
9	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652499_ASM\47652453.stp
10	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652499_ASM\47652499_ASM.stp
11	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652499_ASM\47868753.stp
12	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652510_ASM\14098810.stp
13	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652510_ASM\47652508.stp
14	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652510_ASM\47652509.stp
15	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652510_ASM\47652510_ASM.stp
16	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652512_ASM\14098710.stp
17	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652512_ASM\47652512_ASM.stp
18	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652512_ASM\47652513.stp
19	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652518_ASM\14098810.stp
20	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652518_ASM\47652518_ASM.stp
21	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652518_ASM\47652520.stp
22	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652521_ASMaçılmadı\14098710.stp
23	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652521_ASMaçılmadı\47652521_ASM.stp
24	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652521_ASMaçılmadı\47652522.stp
25	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47652553\47652553.stp
26	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47723128\47723128.stp
27	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47769526_ASM\14098710.stp
28	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47769526_ASM\47769526_ASM.stp
29	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47769526_ASM\47769528.stp
30	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47769529_ASM\14098710.stp
31	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47769529_ASM\47769529_ASM.stp
32	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47769529_ASM\47769530.stp
33	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47814231_ASM\14096900.stp
34	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47814231_ASM\47652454.stp
35	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	47814231_ASM\47814231_ASM.stp
36	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	84396454\84396454.stp
37	.stp	C:\Users\Hakan\Desktop\TTF_DATA_TEK_RES	84396456\84396456.stp
TTF_DATA_TEK_RES

Sub Rearrange()
  Dim a As Variant, b As Variant, Bits As Variant
  Dim i As Long, k As Long
  Dim CurrPref As String
 
  With Range("A2", Range("A" & Rows.Count).End(xlUp))
    a = .Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      Bits = Split(a(i, 1), "\")
      If Bits(0) = CurrPref Then
        b(k, 1) = b(k, 1) & ";" & Bits(1)
      Else
        CurrPref = Bits(0)
        k = k + 1
        b(k, 1) = a(i, 1) & ";" & Bits(1)
      End If
    Next i
    With .Offset(, 1).Resize(k)
      .Value = b
      .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
      .CurrentRegion.Columns.AutoFit
    End With
    .EntireColumn.Delete
  End With
End Sub

here i've changed nothing, at first it worked i even given you feedback, but when i changed the version it started to failure

 

[Peter_SSs]

at first it worked

I should have picked it up earlier but that code would never have worked with this latest sample data in any Excel version.
My code was written for data to be split in column A as per your original post

I have a data set which is in Column A and something like this

.. but the data is actually in column B (which I should have noticed in post #4 but didn't take enough notice because that post was replying to severynm)

Also, my code would put the results in column immediately to the right of the data but it now appears there is already data there so where should the results go?

 

[spasmex97]

I should have picked it up earlier but that code would never have worked with this latest sample data in any Excel version.
My code was written for data to be split in column A as per your original post

.. but the data is actually in column B (which I should have noticed in post #4 but didn't take enough notice because that post was replying to severynm)

Also, my code would put the results in column immediately to the right of the data but it now appears there is already data there so where should the results go?

likely to the another sheet

 

[Peter_SSs]

likely to the another sheet

Does the other sheet already exist in the workbook? If so, what is its name and where on the sheet should the results go?

Also, in your original sample data in post #1 each row contained a single "\", now there are multiple, so I'm not sure just what the results should look like. Could we have the expected results for the last sample data or else a new smaller but representative set of data and the expected results?

 

[spasmex97]

Does the other sheet already exist in the workbook? If so, what is its name and where on the sheet should the results go?

Also, in your original sample data in post #1 each row contained a single "\", now there are multiple, so I'm not sure just what the results should look like. Could we have the expected results for the last sample data or else a new smaller but representative set of data and the expected results?

well actually my sample data and the data i showed you yesterday almost the same, the confusion comes because i also added @links of the datas', so we are still considering the "C" column as the main data, and yes the sheet will be already exists in the workbook, it will be something steady,

 

[Peter_SSs]

See if you can use something like this then.
I have assumed

• The original table is on a sheet called 'Data'
• The existing sheet where the results will go is called 'Results'
• 'Results' does not already contain data (except perhaps headings in row 1)

Sub Rearrange_v2()
  Dim a As Variant, b As Variant, Bits As Variant
  Dim i As Long, k As Long
  Dim CurrPref As String
  
  With Sheets("Data")
    With .Range("C2", .Range("C" & Rows.Count).End(xlUp))
      a = .Value
      ReDim b(1 To UBound(a), 1 To 1)
      For i = 1 To UBound(a)
        If InStr(1, a(i, 1), "\") > 0 Then
          Bits = Split(a(i, 1), "\")
          If Bits(0) = CurrPref Then
            b(k, 1) = b(k, 1) & ";" & Bits(1)
          Else
            CurrPref = Bits(0)
            k = k + 1
            b(k, 1) = a(i, 1) & ";" & Bits(1)
          End If
        End If
      Next i
    End With
  End With
  Application.ScreenUpdating = False
  With Sheets("Results").Range("A2").Resize(k)
    .Value = b
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
    .CurrentRegion.Columns.AutoFit
    .EntireColumn.Delete
  End With
  Application.ScreenUpdating = True
End Sub

 

[spasmex97]

See if you can use something like this then.
I have assumed

• The original table is on a sheet called 'Data'
• The existing sheet where the results will go is called 'Results'
• 'Results' does not already contain data (except perhaps headings in row 1)

Sub Rearrange_v2()
  Dim a As Variant, b As Variant, Bits As Variant
  Dim i As Long, k As Long
  Dim CurrPref As String
 
  With Sheets("Data")
    With .Range("C2", .Range("C" & Rows.Count).End(xlUp))
      a = .Value
      ReDim b(1 To UBound(a), 1 To 1)
      For i = 1 To UBound(a)
        If InStr(1, a(i, 1), "\") > 0 Then
          Bits = Split(a(i, 1), "\")
          If Bits(0) = CurrPref Then
            b(k, 1) = b(k, 1) & ";" & Bits(1)
          Else
            CurrPref = Bits(0)
            k = k + 1
            b(k, 1) = a(i, 1) & ";" & Bits(1)
          End If
        End If
      Next i
    End With
  End With
  Application.ScreenUpdating = False
  With Sheets("Results").Range("A2").Resize(k)
    .Value = b
    .TextToColumns DataType:=xlDelimited, Semicolon:=True, Comma:=False, Space:=False, Other:=False
    .CurrentRegion.Columns.AutoFit
    .EntireColumn.Delete
  End With
  Application.ScreenUpdating = True
End Sub

I have been pretty busy lately, yet i could check it, I thank you very much, it works flawless.

 

[Peter_SSs]

Good news! Thanks for letting us know.