Hi all,

This one is driving me bonkers. I would greatly appreciate any advise.
I can't change the sub drastically as it is embedded within other subs.
It would be better if someone can see a way to use If/Then, For/Next,
or Do/Loops

I have a row of data with variables for a particular subject that looks
like this
respondent variable
1 a
1 b
1 c
1 d
1 e
1 f
1 g
1 h
1 i
1 var1
1 var2
1 var3

The next rows for the next repondent are different such as
2 a
2 b
2 c
2 d
2 e
2 f
2 g
2 h
2 i
2 var1
2 var6
2 var3

The vars of concern (var1, var2, var3, var6, etc are in column M with
the text in column N on the "data" worksheet)

After each column is another column with text

The solution should look something like this on a "groupings" worksheet
Subject var1 var2 var3 var6
1 text text text text
2 text text text text
3 etc etc etc etc

Instead, due to my loop, if the example with var6 were last set of rows
in this column, I would get

Subject var1 var6 var3
1 text text text text
2 text text text text
3 etc etc etc etc



In other words, var6 is replacing var2 instead of creating a new column

To make things a bit more confusing, the same subject can submit scores
in multiple groups. I think I'm ok with this part; the code is
commented to make it a bit more clear


Here's my code. The a,b,c,d,e,f variables aren't included, and this
part works out through the series of If-Then's that precede the
problem.
Sub CalcGroups()

Application.ScreenUpdating = False

n = 1 'This is a counter for every row of data
i = 1 'This is a counter for rows representing a particular subject
j = 1 'This will be used to reset i=1 for the next respondent
k = 1 'This will be used for row indexes on the next worksheet

' Set initial ranges
Range("M1").Select
Range("M1").Activate
Set FirstCell = Selection

'Do for all respondents (main loop)
Do Until FirstCell.Offset(n, 0).Value = ""
m = 10
Sheets("data").Select
Set startcell = FirstCell.Offset(n, 0)
startcell.Select
startcell.Activate
Set RespondentCell = FirstCell.Offset(n, -5) 'the subject id
RespondentCell.Select
RespondentCell.Activate
Set RespondentSeg = FirstCell.Offset(n, -8) 'the subject group
RespondentSeg.Select
RespondentSeg.Activate
Set RespondentCellID = FirstCell.Offset(n, -9)
m = 10 'This will be used to create colunn question headers'

'Do this until a new respondent
Do Until FirstCell.Offset(n, -9).Value < RespondentCellID Or
FirstCell.Offset(n, -5).Value < RespondentCell

Set CurrentCell = FirstCell.Offset(n, 0)
'Look for irrelevant variables such as a and b and store the
scores for this respondent in different columns
If CurrentCell = "a" Then
avar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "b" Then
bvar= CurrentCell.Offset(0, 1)
Else
If CurrentCell = "c" Then
cvar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "d" Then
dvar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "e" Then
evar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "f" Then
fvar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "g" Then
gvar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "h" Then
hvar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "i" Then
ivar = CurrentCell.Offset(0, 1)
Else
'Get the relevant questions such as var1 and var2 and put them
(as well as the text in the next column) on the new worksheet in one
column
CurrentCell.Copy
Sheets("Groupings").Select
Range("A1").Offset(0, m).Select
ActiveSheet.Paste
Range("A1").Offset(0, m).Font.FontStyle = "Bold"

Sheets("data").Select
CurrentCell.Offset(0, 2).Copy
Sheets("Groupings").Select
Range("A1").Offset(k, m).Select
ActiveSheet.Paste
Sheets("data").Select
m = m + 1

End If
End If
End If
End If
End If
End If
End If
End If
End If


i = i + 1 'Update the counter for this respondent
n = n + 1 'Update the overall counter

Loop

Thank you very much!
Jeff Miller

P.S. Feel free to send an e-mail me at if
you would like to see an example as an Excel workbook I will send.

You can take a couple of approaches:

Copy range A and PasteSpecial into Range B with TRANSPOSE checked

There is also a vba transpose function.

"alphapoint05" wrote:

Hi all,

This one is driving me bonkers. I would greatly appreciate any advise.
I can't change the sub drastically as it is embedded within other subs.
It would be better if someone can see a way to use If/Then, For/Next,
or Do/Loops

I have a row of data with variables for a particular subject that looks
like this
respondent variable
1 a
1 b
1 c
1 d
1 e
1 f
1 g
1 h
1 i
1 var1
1 var2
1 var3

The next rows for the next repondent are different such as
2 a
2 b
2 c
2 d
2 e
2 f
2 g
2 h
2 i
2 var1
2 var6
2 var3

The vars of concern (var1, var2, var3, var6, etc are in column M with
the text in column N on the "data" worksheet)

After each column is another column with text

The solution should look something like this on a "groupings" worksheet
Subject var1 var2 var3 var6
1 text text text text
2 text text text text
3 etc etc etc etc

Instead, due to my loop, if the example with var6 were last set of rows
in this column, I would get

Subject var1 var6 var3
1 text text text text
2 text text text text
3 etc etc etc etc



In other words, var6 is replacing var2 instead of creating a new column

To make things a bit more confusing, the same subject can submit scores
in multiple groups. I think I'm ok with this part; the code is
commented to make it a bit more clear


Here's my code. The a,b,c,d,e,f variables aren't included, and this
part works out through the series of If-Then's that precede the
problem.
Sub CalcGroups()

Application.ScreenUpdating = False

n = 1 'This is a counter for every row of data
i = 1 'This is a counter for rows representing a particular subject
j = 1 'This will be used to reset i=1 for the next respondent
k = 1 'This will be used for row indexes on the next worksheet

' Set initial ranges
Range("M1").Select
Range("M1").Activate
Set FirstCell = Selection

'Do for all respondents (main loop)
Do Until FirstCell.Offset(n, 0).Value = ""
m = 10
Sheets("data").Select
Set startcell = FirstCell.Offset(n, 0)
startcell.Select
startcell.Activate
Set RespondentCell = FirstCell.Offset(n, -5) 'the subject id
RespondentCell.Select
RespondentCell.Activate
Set RespondentSeg = FirstCell.Offset(n, -8) 'the subject group
RespondentSeg.Select
RespondentSeg.Activate
Set RespondentCellID = FirstCell.Offset(n, -9)
m = 10 'This will be used to create colunn question headers'

'Do this until a new respondent
Do Until FirstCell.Offset(n, -9).Value < RespondentCellID Or
FirstCell.Offset(n, -5).Value < RespondentCell

Set CurrentCell = FirstCell.Offset(n, 0)
'Look for irrelevant variables such as a and b and store the
scores for this respondent in different columns
If CurrentCell = "a" Then
avar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "b" Then
bvar= CurrentCell.Offset(0, 1)
Else
If CurrentCell = "c" Then
cvar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "d" Then
dvar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "e" Then
evar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "f" Then
fvar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "g" Then
gvar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "h" Then
hvar = CurrentCell.Offset(0, 1)
Else
If CurrentCell = "i" Then
ivar = CurrentCell.Offset(0, 1)
Else
'Get the relevant questions such as var1 and var2 and put them
(as well as the text in the next column) on the new worksheet in one
column
CurrentCell.Copy
Sheets("Groupings").Select
Range("A1").Offset(0, m).Select
ActiveSheet.Paste
Range("A1").Offset(0, m).Font.FontStyle = "Bold"

Sheets("data").Select
CurrentCell.Offset(0, 2).Copy
Sheets("Groupings").Select
Range("A1").Offset(k, m).Select
ActiveSheet.Paste
Sheets("data").Select
m = m + 1

End If
End If
End If
End If
End If
End If
End If
End If
End If


i = i + 1 'Update the counter for this respondent
n = n + 1 'Update the overall counter

Loop

Thank you very much!
Jeff Miller

P.S. Feel free to send an e-mail me at if
you would like to see an example as an Excel workbook I will send.