I want to separate questions and choices of a test.little sample of file is
http://studyenglishgrammar.net/test.xlsx
I think you will like this
Option Explicit
Option Private Module
Sub FixTestQuestionsSAS()
Dim i As Long
Dim c As Integer
Dim ml As String
Dim x As Long
Dim mr As Range
Dim mrr As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
For c = 69 To 65 Step -1
ml = Chr(c) & ")"
x = InStrRev(Cells(i, 1), ml)
'MsgBox x
If x > 0 Then
'MsgBox Chr(c) & " found in row " & i & " in position " & x
Range("b2").Insert
Range("b2").Value = Mid(Cells(i, 1), x, 256)
'MsgBox Left(Cells(i, 1), x)
Cells(i, 1) = Left(Cells(i, 1), x - 1)
ElseIf Not IsNumeric(Left(Cells(i, 1), 1)) Then
Cells(i - 1, 1) = Cells(i - 1, 1) & " " & Cells(i, 1)
Cells(i, 1).Clear
End If
Next c
Next i
'line em up
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 1) <> "" Then
Set mr = Columns("B").Find(What:="A)", After:=Cells(i - 1, 2), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
If Not mr Is Nothing Then mrr = mr.Row
'MsgBox mrr
Cells(i, 1).Cut Destination:=Cells(mrr, 1)
End If
Next i
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Sub GetRawData()
Columns("A:C").ClearContents
Sheets("Sayfa1").Range("A1:A15").Copy Range("a1")
End Sub
