Moving a group of cells based on its value in a column to a different column

Hi, I have an extensive data set obtained from a eyetracking program. After cleaning the data, I get 2 columns (really long), one with the name os the stimulus (e.g. 2002.jpg) and another with the pupilsize obtained (each row represents a sample obtained). I want to break this 2 columns in a serie of adjacent columns, where every pair of columns have a different stimulus with its respective pupilsize. There are some images below explaining what I need:

parte1.jpgparte2.jpg


The number of stimulus and the number of rows for each stimulus is variable, as well as its name (but they never have the same name). Anyone can help me?

TIA,

Gabriel

Gabriel,

Here is some code that will take the data in Columns A and B of the current sheet and redistribute them per your description in a new sheet.

Sub separate_data()

Dim numrows As Long
Dim lastrow As Long
Dim i As Long
Dim sData() As Variant

' Find Last Row with Data in Column A
numrows = Application.Rows.Count
lastrow = Range(Cells(numrows, 1), Cells(numrows, 1)).End(xlUp).Row

' Delete rows where cell in Column A is blank
For i = lastrow To 1 Step -1
   If IsEmpty(Cells(i, 1)) Then
      Rows(i).Select
      Selection.Delete shift:=xlUp
   End If
Next i

' Reset lastrow variable
lastrow = Range(Cells(numrows, 1), Cells(numrows, 1)).End(xlUp).Row

' Sort data in Column A so all like strings are together
Columns("A:A").Select
Range("A1:B" & lastrow).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
   xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
   DataOption1:=xlSortNormal
Range("A1").Select

' Define 'sData' array and populate variable
ReDim sData(1 To lastrow, 2) As Variant
For i = 1 To lastrow
   sData(i, 1) = Cells(i, 1): sData(i, 2) = Cells(i, 2)
Next i

' Make New Sheet called "Data Distribution"
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Data Distribution"

' Put separated data into "Data Distribution" sheet
ncol = 1
nrow = 1
Cells(nrow, ncol) = sData(1, 1): Cells(nrow, ncol + 1) = sData(1, 2)
For i = 2 To lastrow
   If (sData((i - 1), 1) <> sData(i, 1)) Then
      nrow = 1: ncol = ncol + 2
      Cells(nrow, ncol) = sData(i, 1): Cells(nrow, ncol + 1) = sData(i, 2)
   Else
      nrow = nrow + 1
      Cells(nrow, ncol) = sData(i, 1): Cells(nrow, ncol + 1) = sData(i, 2)
   End If
Next i

MsgBox "Process complete."

End Sub

Hope that helps,

Daniel