ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Is there any way to solve this problem ? (https://www.excelbanter.com/excel-programming/410570-there-any-way-solve-problem.html)

/-_-b

Is there any way to solve this problem ?
 
Hi all!

I got a problem with my macro... this is basically macro for sorting
questions and answers from 2 sheets into a new one. The result looks like
this :

-----------------------------------------------------------------------------------
| A | B |
C |
-----------------------------------------------------------------------------------
| 1 | Who was the first... |
|
-----------------------------------------------------------------------------------
| | Lincoln |
|
-------------------------------------------------------------------------------------
| | Washington |
+ |
-------------------------------------------------------------------------------------
| | Clinton |
|
--------------------------------------------------------------------------------------
| 2 | The only animal... |
|
----------------------------------------------------------------------------------------
| | leopard |
|
----------------------------------------------------------------------------------------
......


My question : is there any way to insert :
1) a), b), c), d)... before the answers
2) blank row indent between 2 questions

to make one more sheet with the correct answers, ex. :

1 C, 2 B, 3 D and so on..


Here's my code :

Sub macro1()
'
' gsnuxx
' rev 1
'
k = 1
Set q = Sheets("questions")
Set a = Sheets("answers")
Set qa = Sheets("qa")
nq = q.Cells(Rows.Count, "A").End(xlUp).Row
na = a.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To nq
n = q.Cells(i, 1).Value
qa.Cells(k, 1).Value = n
qa.Cells(k, 2).Value = q.Cells(i, 2).Value
qa.Cells(k, 2).Font.Bold = True

k = k + 1
For j = 1 To na
m = a.Cells(j, 1).Value
If m = n Then
qa.Cells(k, 2).Value = a.Cells(j, 2).Value
If a.Cells(j, 3).Value = 0 Then
qa.Cells(k, 3).Value = " "
Else
qa.Cells(k, 3).Value = "+"
End If
k = k + 1
End If
Next
Next
End Sub


Ty in advance !



Bob Phillips

Is there any way to solve this problem ?
 
Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
End If
.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " & .Cells(i,
TEST_COLUMN).Value
letter = letter + 1
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < "" Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"/-_-b" wrote in message
...
Hi all!

I got a problem with my macro... this is basically macro for sorting
questions and answers from 2 sheets into a new one. The result looks like
this :

-----------------------------------------------------------------------------------
| A | B | C
|
-----------------------------------------------------------------------------------
| 1 | Who was the first... | |
-----------------------------------------------------------------------------------
| | Lincoln | |
-------------------------------------------------------------------------------------
| | Washington | +
|
-------------------------------------------------------------------------------------
| | Clinton | |
--------------------------------------------------------------------------------------
| 2 | The only animal... | |
----------------------------------------------------------------------------------------
| | leopard | |
----------------------------------------------------------------------------------------
.....


My question : is there any way to insert :
1) a), b), c), d)... before the answers
2) blank row indent between 2 questions

to make one more sheet with the correct answers, ex. :

1 C, 2 B, 3 D and so on..


Here's my code :

Sub macro1()
'
' gsnuxx
' rev 1
'
k = 1
Set q = Sheets("questions")
Set a = Sheets("answers")
Set qa = Sheets("qa")
nq = q.Cells(Rows.Count, "A").End(xlUp).Row
na = a.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To nq
n = q.Cells(i, 1).Value
qa.Cells(k, 1).Value = n
qa.Cells(k, 2).Value = q.Cells(i, 2).Value
qa.Cells(k, 2).Font.Bold = True

k = k + 1
For j = 1 To na
m = a.Cells(j, 1).Value
If m = n Then
qa.Cells(k, 2).Value = a.Cells(j, 2).Value
If a.Cells(j, 3).Value = 0 Then
qa.Cells(k, 3).Value = " "
Else
qa.Cells(k, 3).Value = "+"
End If
k = k + 1
End If
Next
Next
End Sub


Ty in advance !





/-_-b

Is there any way to solve this problem ?
 
Thank you Bob, everything works great ... except the code starts to put a)
in front of the question, instead starting from the first answer to the
question. Can this be fixed ? The questions are in bold, maybe that could
help.

Ty

Marko

"Bob Phillips" wrote in message
...
Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
End If
.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " & .Cells(i,
TEST_COLUMN).Value
letter = letter + 1
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < "" Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Hi all!

I got a problem with my macro... this is basically macro for sorting
questions and answers from 2 sheets into a new one. The result looks like
this :

-----------------------------------------------------------------------------------
| A | B | C |
-----------------------------------------------------------------------------------
| 1 | Who was the first... | |
-----------------------------------------------------------------------------------
| | Lincoln | |
-------------------------------------------------------------------------------------
| | Washington | + |
-------------------------------------------------------------------------------------
| | Clinton | |
--------------------------------------------------------------------------------------
| 2 | The only animal... | |
----------------------------------------------------------------------------------------
| | leopard | |
----------------------------------------------------------------------------------------
.....


My question : is there any way to insert :
1) a), b), c), d)... before the answers
2) blank row indent between 2 questions

to make one more sheet with the correct answers, ex. :

1 C, 2 B, 3 D and so on..


Here's my code :

Sub macro1()
'
' gsnuxx
' rev 1
'
k = 1
Set q = Sheets("questions")
Set a = Sheets("answers")
Set qa = Sheets("qa")
nq = q.Cells(Rows.Count, "A").End(xlUp).Row
na = a.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To nq
n = q.Cells(i, 1).Value
qa.Cells(k, 1).Value = n
qa.Cells(k, 2).Value = q.Cells(i, 2).Value
qa.Cells(k, 2).Font.Bold = True

k = k + 1
For j = 1 To na
m = a.Cells(j, 1).Value
If m = n Then
qa.Cells(k, 2).Value = a.Cells(j, 2).Value
If a.Cells(j, 3).Value = 0 Then
qa.Cells(k, 3).Value = " "
Else
qa.Cells(k, 3).Value = "+"
End If
k = k + 1
End If
Next
Next
End Sub


Ty in advance !







Bob Phillips

Is there any way to solve this problem ?
 
Ooops, what a gaffe!

Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
Else

.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " &
..Cells(i, TEST_COLUMN).Value
letter = letter + 1
End If
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < "" Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub



--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"/-_-b" wrote in message
...
Thank you Bob, everything works great ... except the code starts to put a)
in front of the question, instead starting from the first answer to the
question. Can this be fixed ? The questions are in bold, maybe that could
help.

Ty

Marko

"Bob Phillips" wrote in message
...
Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
End If
.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " & .Cells(i,
TEST_COLUMN).Value
letter = letter + 1
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < "" Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Hi all!

I got a problem with my macro... this is basically macro for sorting
questions and answers from 2 sheets into a new one. The result looks
like this :

-----------------------------------------------------------------------------------
| A | B | C |
-----------------------------------------------------------------------------------
| 1 | Who was the first... | |
-----------------------------------------------------------------------------------
| | Lincoln | |
-------------------------------------------------------------------------------------
| | Washington | + |
-------------------------------------------------------------------------------------
| | Clinton | |
--------------------------------------------------------------------------------------
| 2 | The only animal... | |
----------------------------------------------------------------------------------------
| | leopard | |
----------------------------------------------------------------------------------------
.....


My question : is there any way to insert :
1) a), b), c), d)... before the answers
2) blank row indent between 2 questions

to make one more sheet with the correct answers, ex. :

1 C, 2 B, 3 D and so on..


Here's my code :

Sub macro1()
'
' gsnuxx
' rev 1
'
k = 1
Set q = Sheets("questions")
Set a = Sheets("answers")
Set qa = Sheets("qa")
nq = q.Cells(Rows.Count, "A").End(xlUp).Row
na = a.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To nq
n = q.Cells(i, 1).Value
qa.Cells(k, 1).Value = n
qa.Cells(k, 2).Value = q.Cells(i, 2).Value
qa.Cells(k, 2).Font.Bold = True

k = k + 1
For j = 1 To na
m = a.Cells(j, 1).Value
If m = n Then
qa.Cells(k, 2).Value = a.Cells(j, 2).Value
If a.Cells(j, 3).Value = 0 Then
qa.Cells(k, 3).Value = " "
Else
qa.Cells(k, 3).Value = "+"
End If
k = k + 1
End If
Next
Next
End Sub


Ty in advance !









/-_-b

Is there any way to solve this problem ?
 
Ty Bob , this works just fine !


"Bob Phillips" wrote in message
...
Ooops, what a gaffe!

Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
Else

.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " &
.Cells(i, TEST_COLUMN).Value
letter = letter + 1
End If
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < "" Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub



--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Thank you Bob, everything works great ... except the code starts to put
a) in front of the question, instead starting from the first answer to
the question. Can this be fixed ? The questions are in bold, maybe that
could help.

Ty

Marko

"Bob Phillips" wrote in message
...
Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
End If
.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " & .Cells(i,
TEST_COLUMN).Value
letter = letter + 1
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < "" Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Hi all!

I got a problem with my macro... this is basically macro for sorting
questions and answers from 2 sheets into a new one. The result looks
like this :

-----------------------------------------------------------------------------------
| A | B | C
|
-----------------------------------------------------------------------------------
| 1 | Who was the first... | |
-----------------------------------------------------------------------------------
| | Lincoln | |
-------------------------------------------------------------------------------------
| | Washington | + |
-------------------------------------------------------------------------------------
| | Clinton | |
--------------------------------------------------------------------------------------
| 2 | The only animal... | |
----------------------------------------------------------------------------------------
| | leopard | |
----------------------------------------------------------------------------------------
.....


My question : is there any way to insert :
1) a), b), c), d)... before the answers
2) blank row indent between 2 questions

to make one more sheet with the correct answers, ex. :

1 C, 2 B, 3 D and so on..


Here's my code :

Sub macro1()
'
' gsnuxx
' rev 1
'
k = 1
Set q = Sheets("questions")
Set a = Sheets("answers")
Set qa = Sheets("qa")
nq = q.Cells(Rows.Count, "A").End(xlUp).Row
na = a.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To nq
n = q.Cells(i, 1).Value
qa.Cells(k, 1).Value = n
qa.Cells(k, 2).Value = q.Cells(i, 2).Value
qa.Cells(k, 2).Font.Bold = True

k = k + 1
For j = 1 To na
m = a.Cells(j, 1).Value
If m = n Then
qa.Cells(k, 2).Value = a.Cells(j, 2).Value
If a.Cells(j, 3).Value = 0 Then
qa.Cells(k, 3).Value = " "
Else
qa.Cells(k, 3).Value = "+"
End If
k = k + 1
End If
Next
Next
End Sub


Ty in advance !











Bob Phillips

Is there any way to solve this problem ?
 
I see you use Ty, what does it mean? Is it some forma of Ta?

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"/-_-b" wrote in message
...
Ty Bob , this works just fine !


"Bob Phillips" wrote in message
...
Ooops, what a gaffe!

Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
Else

.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " &
.Cells(i, TEST_COLUMN).Value
letter = letter + 1
End If
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < "" Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub



--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Thank you Bob, everything works great ... except the code starts to put
a) in front of the question, instead starting from the first answer to
the question. Can this be fixed ? The questions are in bold, maybe that
could help.

Ty

Marko

"Bob Phillips" wrote in message
...
Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
End If
.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " &
.Cells(i, TEST_COLUMN).Value
letter = letter + 1
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < "" Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Hi all!

I got a problem with my macro... this is basically macro for sorting
questions and answers from 2 sheets into a new one. The result looks
like this :

-----------------------------------------------------------------------------------
| A | B | C
|
-----------------------------------------------------------------------------------
| 1 | Who was the first... | |
-----------------------------------------------------------------------------------
| | Lincoln | |
-------------------------------------------------------------------------------------
| | Washington | + |
-------------------------------------------------------------------------------------
| | Clinton | |
--------------------------------------------------------------------------------------
| 2 | The only animal... | |
----------------------------------------------------------------------------------------
| | leopard | |
----------------------------------------------------------------------------------------
.....


My question : is there any way to insert :
1) a), b), c), d)... before the answers
2) blank row indent between 2 questions

to make one more sheet with the correct answers, ex. :

1 C, 2 B, 3 D and so on..


Here's my code :

Sub macro1()
'
' gsnuxx
' rev 1
'
k = 1
Set q = Sheets("questions")
Set a = Sheets("answers")
Set qa = Sheets("qa")
nq = q.Cells(Rows.Count, "A").End(xlUp).Row
na = a.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To nq
n = q.Cells(i, 1).Value
qa.Cells(k, 1).Value = n
qa.Cells(k, 2).Value = q.Cells(i, 2).Value
qa.Cells(k, 2).Font.Bold = True

k = k + 1
For j = 1 To na
m = a.Cells(j, 1).Value
If m = n Then
qa.Cells(k, 2).Value = a.Cells(j, 2).Value
If a.Cells(j, 3).Value = 0 Then
qa.Cells(k, 3).Value = " "
Else
qa.Cells(k, 3).Value = "+"
End If
k = k + 1
End If
Next
Next
End Sub


Ty in advance !













/-_-b

Is there any way to solve this problem ?
 
LOL. Nah. I'm just saying thank you.

"Bob Phillips" wrote in message
...
I see you use Ty, what does it mean? Is it some forma of Ta?

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Ty Bob , this works just fine !


"Bob Phillips" wrote in message
...
Ooops, what a gaffe!

Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
Else

.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " &
.Cells(i, TEST_COLUMN).Value
letter = letter + 1
End If
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < "" Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub



--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Thank you Bob, everything works great ... except the code starts to put
a) in front of the question, instead starting from the first answer to
the question. Can this be fixed ? The questions are in bold, maybe that
could help.

Ty

Marko

"Bob Phillips" wrote in message
...
Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
End If
.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " &
.Cells(i, TEST_COLUMN).Value
letter = letter + 1
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < ""
Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Hi all!

I got a problem with my macro... this is basically macro for sorting
questions and answers from 2 sheets into a new one. The result looks
like this :

-----------------------------------------------------------------------------------
| A | B |
C |
-----------------------------------------------------------------------------------
| 1 | Who was the first... | |
-----------------------------------------------------------------------------------
| | Lincoln | |
-------------------------------------------------------------------------------------
| | Washington | + |
-------------------------------------------------------------------------------------
| | Clinton | |
--------------------------------------------------------------------------------------
| 2 | The only animal... | |
----------------------------------------------------------------------------------------
| | leopard | |
----------------------------------------------------------------------------------------
.....


My question : is there any way to insert :
1) a), b), c), d)... before the answers
2) blank row indent between 2 questions

to make one more sheet with the correct answers, ex. :

1 C, 2 B, 3 D and so on..


Here's my code :

Sub macro1()
'
' gsnuxx
' rev 1
'
k = 1
Set q = Sheets("questions")
Set a = Sheets("answers")
Set qa = Sheets("qa")
nq = q.Cells(Rows.Count, "A").End(xlUp).Row
na = a.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To nq
n = q.Cells(i, 1).Value
qa.Cells(k, 1).Value = n
qa.Cells(k, 2).Value = q.Cells(i, 2).Value
qa.Cells(k, 2).Font.Bold = True

k = k + 1
For j = 1 To na
m = a.Cells(j, 1).Value
If m = n Then
qa.Cells(k, 2).Value = a.Cells(j, 2).Value
If a.Cells(j, 3).Value = 0 Then
qa.Cells(k, 3).Value = " "
Else
qa.Cells(k, 3).Value = "+"
End If
k = k + 1
End If
Next
Next
End Sub


Ty in advance !















Bob Phillips

Is there any way to solve this problem ?
 
LOL! Never occurred to me!

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"/-_-b" wrote in message
...
LOL. Nah. I'm just saying thank you.

"Bob Phillips" wrote in message
...
I see you use Ty, what does it mean? Is it some forma of Ta?

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Ty Bob , this works just fine !


"Bob Phillips" wrote in message
...
Ooops, what a gaffe!

Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
Else

.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " &
.Cells(i, TEST_COLUMN).Value
letter = letter + 1
End If
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < "" Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub



--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Thank you Bob, everything works great ... except the code starts to
put a) in front of the question, instead starting from the first
answer to the question. Can this be fixed ? The questions are in bold,
maybe that could help.

Ty

Marko

"Bob Phillips" wrote in message
...
Public Sub ProcessData()
Const TEST_COLUMN As String = "B" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim letter As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Offset(0, -1).Value < "" Then

letter = 97
End If
.Cells(i, TEST_COLUMN).Value = Chr(letter) & ") " &
.Cells(i, TEST_COLUMN).Value
letter = letter + 1
Next i
For i = LastRow - 1 To 1 Step -1

If .Cells(i + 1, TEST_COLUMN).Offset(0, -1).Value < ""
Then

.Rows(i + 1).Resize(2).Insert
End If
Next i
End With

End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)

"/-_-b" wrote in message
...
Hi all!

I got a problem with my macro... this is basically macro for sorting
questions and answers from 2 sheets into a new one. The result looks
like this :

-----------------------------------------------------------------------------------
| A | B |
C |
-----------------------------------------------------------------------------------
| 1 | Who was the first... | |
-----------------------------------------------------------------------------------
| | Lincoln | |
-------------------------------------------------------------------------------------
| | Washington | + |
-------------------------------------------------------------------------------------
| | Clinton |
|
--------------------------------------------------------------------------------------
| 2 | The only animal... | |
----------------------------------------------------------------------------------------
| | leopard | |
----------------------------------------------------------------------------------------
.....


My question : is there any way to insert :
1) a), b), c), d)... before the answers
2) blank row indent between 2 questions

to make one more sheet with the correct answers, ex. :

1 C, 2 B, 3 D and so on..


Here's my code :

Sub macro1()
'
' gsnuxx
' rev 1
'
k = 1
Set q = Sheets("questions")
Set a = Sheets("answers")
Set qa = Sheets("qa")
nq = q.Cells(Rows.Count, "A").End(xlUp).Row
na = a.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To nq
n = q.Cells(i, 1).Value
qa.Cells(k, 1).Value = n
qa.Cells(k, 2).Value = q.Cells(i, 2).Value
qa.Cells(k, 2).Font.Bold = True

k = k + 1
For j = 1 To na
m = a.Cells(j, 1).Value
If m = n Then
qa.Cells(k, 2).Value = a.Cells(j, 2).Value
If a.Cells(j, 3).Value = 0 Then
qa.Cells(k, 3).Value = " "
Else
qa.Cells(k, 3).Value = "+"
End If
k = k + 1
End If
Next
Next
End Sub


Ty in advance !


















All times are GMT +1. The time now is 08:37 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com