Irregular Data Set

[IdabaMalouki]

I have a data set I copy and paste from a website. Someone helped me write a VBA code to sort the data:

Option Explicit

Sub demo()
Dim a, b
Dim i As Long, j As Long, n As Long

a = [A1].CurrentRegion
ReDim b(1 To UBound(a, 1), 1 To 7)

For i = 2 To UBound(a, 1) Step 5
    n = n + 1
    b(n, 1) = a(i, 1): b(n, 2) = a(i + 2, 1): b(n + 1, 2) = a(i + 4, 1)
   
    b(n, 3) = a(i, 2): b(n, 4) = a(i + 1, 2)
    b(n, 5) = a(i, 3): b(n, 6) = a(i + 1, 3): b(n, 7) = a(i, 4)
    n = n + 1
    b(n, 3) = a(i + 3, 2): b(n, 4) = a(i + 4, 2)
    b(n, 5) = a(i + 3, 3): b(n, 6) = a(i + 4, 3): b(n, 7) = a(i + 3, 4)
   
Next i

[N2].Resize(n, 7) = b

End Sub

Can some help write a similar VBA for the new irregular data set in this excel workbook that will organize data in column A into format of adjacent columns:

Thanks in advance

 

[DanteAmor]

Welcome to the MrExcel forum. Please accept my warmest greetings

Try this:

Sub sortdata()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
  
  a = Range("A1", Range("A" & Rows.Count).End(3)).Value
  ReDim b(1 To UBound(a, 1), 1 To 7)
  
  For i = 1 To UBound(a, 1) Step 16
    k = k + 1
    b(k, 1) = a(i, 1)
    b(k, 2) = a(i + 1, 1)
    b(k, 3) = a(i + 4, 1)
    b(k, 4) = a(i + 5, 1)
    b(k, 5) = a(i + 9, 1)
    b(k, 6) = a(i + 12, 1)
    b(k, 7) = a(i + 13, 1)
    k = k + 1
    b(k, 2) = a(i + 2, 1)
    b(k, 3) = a(i + 6, 1)
    b(k, 4) = a(i + 7, 1)
    b(k, 5) = a(i + 10, 1)
    b(k, 6) = a(i + 14, 1)
    b(k, 7) = a(i + 15, 1)
  Next

  Range("C2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

----- --
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
----- --

 

[IdabaMalouki]

Hey Dante. Thanks for the help. It works fine, but I forgot to add that column A can contains upwards of 2000 cells of that data. Any way to tweak it so it covers 2000 cells in Column A? Thanks in advance

 

[DanteAmor]

Any way to tweak it so it covers 2000 cells in Column A?

It is not a problem of the macro capacity.
Each of your blocks should be 16 lines long, so the total lines in your column A should be a multiple of 16. If it is not a multiple of 16, then you have incomplete information in one of your blocks.

Try the following macro, the macro will check that the blocks are 16 lines each. This way you won't make any mistakes.

Sub sortdata()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long, lr As Long, n As Long
  
  lr = Range("A" & Rows.Count).End(3).Row
  n = 16 - (lr Mod 16)
  
  a = Range("A1:A" & lr + n).Value
  ReDim b(1 To UBound(a, 1), 1 To 7)
  
  For i = 1 To UBound(a, 1) Step 16
    k = k + 1
    b(k, 1) = a(i, 1)
    b(k, 2) = a(i + 1, 1)
    b(k, 3) = a(i + 4, 1)
    b(k, 4) = a(i + 5, 1)
    b(k, 5) = a(i + 9, 1)
    b(k, 6) = a(i + 12, 1)
    b(k, 7) = a(i + 13, 1)
    k = k + 1
    b(k, 2) = a(i + 2, 1)
    b(k, 3) = a(i + 6, 1)
    b(k, 4) = a(i + 7, 1)
    b(k, 5) = a(i + 10, 1)
    b(k, 6) = a(i + 14, 1)
    b(k, 7) = a(i + 15, 1)
  Next

  Range("C2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

[IdabaMalouki]

Works great for half the lines, but then breaks down.

 

[IdabaMalouki]

Sorry, data is not complete. Goes from 16 lines to 14 later down the list

 

[IdabaMalouki]

So when I eliminated the two blocks of 14 lines, your code works perfectly.

 

[DanteAmor]

So when I eliminated the two blocks of 14 lines

Do not delete those blocks, add the 2 missing lines to those blocks.
Run the macro again.

 

[DanteAmor]

If you have blocks with different numbers of lines, then another pattern will have to be found to identify each block.
For example, do all blocks start with a date which has a vertical line?

----- --
I hope to hear from you soon.
Respectfully
Dante Amor
----- --

 

[IdabaMalouki]

Hey, Dante, apologies for delayed response. Travel and work crazy. Yes, each block begins with that strange date format with a vertical separator. Not even quite sure what that character is! Lol!