n00b to VBA needing assistance

[Mr_Mooo]

Hi All,

I am new to the world of VBA, and have starting to feel a little frustrated with something I thought would be simple enough to do, but isn't working the way I would have hoped.

I have a large table of data with three columns. The first column consists of an ID value incrementing from 1 and the next two columns are X,Y plot points associated with that ID number. It looks like the following

1 2.342 6.134
1 2.356 6.012
1 2.488 5.567
2 4.567 8.545
2 4.212 7.456
3 7.324 4.345

etc.

Each ID can have as many as 300+ rows associated with it, or as few as 1.

What I am trying to do is Look at the sheet with all of the data, go down line by line checking the ID value, and if it is the same as the previous ID moving the X and Y coords to a new sheet. When a new ID is found, I want it to still move them to the new sheet, but I want the coords to be put into the next available columns. The only other part is I am only wanting up to 60 ID's per sheet, as some datasets have up to 900+ ID's and it is hard to view what is occurring with so many instances overlapping each other.

It is a transposition of sorts I guess. I am not sure if there is a simpler method, but I am unsure of the correct VBA syntax required and having issues I thought would be simple.

Any suggestions would help.

    Dim k As Long
    Dim i As Long
    Dim rowlength As Long
    
    Dim ColumnPos As String
    Dim RowPos As Long
    Dim NewSheetFlag As Boolean
    
    Dim New_ID As Long
    Dim Old_ID As Long
    
    Dim ModResult
    
    k = 1
    
    Do
        k = k + 1
    Loop Until Cells(k, 2) = ""
    rowlength = k - 1
    
    Application.StatusBar = "Last non-empty row is " & rowlength
    
    While i < rowlength
        Old_ID = New_ID
        New_ID = Range("A" & i).Value     ' Get New_ID Value
        
        ModResult = New_ID Mod 60
        
        If ModResult = 0 And NewSheetFlag = False Then  ' Check if New_ID has hit 60 if so new sheet
            Sheets.Add After:=ActiveSheet
            NewSheetFlag = True
            ColumnPos = "A"
        End If
        
        If Not (ModResult = 0) Then         ' Reset the Flag if no longer Mod 60
            NewSheetFlag = False
        End If
        
        If Not (Old_ID = New_ID) And NewSheetFlag = False Then
            ColumnPos = ColumnPos + 2       ' Check if a New_ID has occured
            RowPos = 1
        Else
            RowPos = RowPos + 1
        End If
        
        Sheets("Test_data").Select          ' Move the Data as needs be
        Range("B" & i & ":C" & i).Select
        Selection.Copy
        Sheets("Sheet2").Select
        Range(ColumnPos & RowPos).Select
        ActiveSheet.Paste
    Wend
    
    Application.StatusBar = "Job Done!"

Thanks.

 

[Rick Rothstein]

I have a large table of data with three columns. The first column consists of an ID value incrementing from 1 and the next two columns are X,Y plot points associated with that ID number. It looks like the following

1 2.342 6.134
1 2.356 6.012
1 2.488 5.567
2 4.567 8.545
2 4.212 7.456
3 7.324 4.345

etc.

Each ID can have as many as 300+ rows associated with it, or as few as 1.

What I am trying to do is Look at the sheet with all of the data, go down line by line checking the ID value, and if it is the same as the previous ID moving the X and Y coords to a new sheet. When a new ID is found, I want it to still move them to the new sheet, but I want the coords to be put into the next available columns.

Does this code do what you want (change the red sheet name to your actual sheet name where the output is to go)?

Sub RearrangeIDs()
  Dim X As Long, R As Long, C As Long, IDcount As Long
  Dim DataIn As Variant, DataOut As Variant
  IDcount = Cells(Rows.Count, "A").End(xlUp).Value
  DataIn = Range("A1:C" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
  ReDim DataOut(1 To UBound(DataIn), 1 To 3 * IDcount)
  R = 1
  C = 1
  For X = 1 To UBound(DataIn) - 1
    DataOut(R, C) = DataIn(X, 1)
    DataOut(R, C + 1) = DataIn(X, 2)
    DataOut(R, C + 2) = DataIn(X, 3)
    If DataIn(X, 1) <> DataIn(X + 1, 1) Then
      R = 1
      C = C + 3
    Else
      R = R + 1
    End If
  Next
  Sheets("[COLOR=#ff0000][B]Sheet3[/B][/COLOR]").Range("A1").Resize(UBound(DataOut), 3 * IDcount) = DataOut
End Sub

 

[Mr_Mooo]

Thank-you so much Rick! This is heading to exactly what I want! I really need to learn how to use arrays better

How can I limit it to grabbing 60 arrays at a time and adding them to a new sheet? Currently if I run it over my entire dataset, which for one of them is 45k+ rows of data, I get an out of memory error. I thought that limiting it to 60 ID's per sheet would remove this error and allow me to see the data more clearly.

In my original code I was using the MOD of 60 to define if a new sheet was needed, but I don't know how to handle accessing a varying sheet name.

Thanks again.