Irregular Data Set

IdabaMalouki

New Member
Joined
Sep 10, 2024
Messages
11
Office Version
  1. 2021
Platform
  1. Windows
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

VBA Code:
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:

1725975748134.png


Thanks in advance
 
Last edited by a moderator:

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Welcome to the MrExcel forum. Please accept my warmest greetings

Try this:

VBA Code:
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
----- --
 
Upvote 0
Solution
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
 
Upvote 0
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.

VBA Code:
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
 
Upvote 0
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?

1726065687071.png



----- --
I hope to hear from you soon.
Respectfully
Dante Amor
----- --
 
Upvote 0
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!
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top