rhoknee

04-23-2010, 05:16 PM

I have a poll of numbers in the worksheet POLL, on the page named "MAIN". When I run the macro below, It produces the results on another page called "OUTPUT". However I would like to have the results on the same page I.E " MAIN", 4 COLUMNS away from the main poll of numbers and,4 ROWS between them.

Can some one please help me.

Sub Main()

Dim u As Integer

Dim i As Integer

Dim j As Integer

Dim jj As Integer

Dim cc As Integer

Dim c As Integer

Dim f As Integer

Dim k As Integer

u = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

Range("Q:CZ").ClearContents

For i = 5 To u

Cells(i, 17) = Trim("'" & Cells(i, 5) & Cells(i, 6) & "" & Cells(i, 7) & "" & Cells(i, 8) & "" & Cells(i, 9) & "" & Cells(i, 10) & "" & Cells(i, 11) & "" & Cells(i, 12) & "" & Cells(i, 13))

Next i

c = 18

f = u

k = 0

For j = 5 To u

If Trim(Cells(j, 17)) = "?" Then Exit For

If InStr(Cells(j, 17), "?") > 0 Then

zStr = Cells(j, 17)

lStr = Len(Cells(j, 17))

For jj = j To 5 Step -1

If Left(Cells(jj, 17), lStr - 1) = Left(zStr, lStr - 1) Then

Cells(f - k, c) = Cells(jj, 17)

k = k + 1

End If

Next jj

c = c + 1

k = 0

End If '''

Next j

Columns(17).ClearContents

q = c

For cc = c To 18 Step -1

If Cells(u - 1, cc) = "" Then

Columns(cc).EntireColumn.Delete

q = q - 1

End If

Next cc

Cells(1, 1).Select

Sheets("Output").Cells.ClearContents

For m = 18 To q

u1 = u

For n = u To 5 Step -1

If Sheets("Main").Cells(n, m) = "" Then

d = d + zL + 1

Exit For

End If

zL = Len(Sheets("Main").Cells(n, m))

For h = 1 To zL

Sheets("Output").Cells(u1, h + d) = Mid(Sheets("Main").Cells(n, m), h, 1)

Next h

u1 = u1 - 1

Next n

Next m

Sheets("main").Range("Q:CZ").ClearContents

Sheets("Output").Select

Cells(u, 1).Select

End Sub

Thank you in advance.

Can some one please help me.

Sub Main()

Dim u As Integer

Dim i As Integer

Dim j As Integer

Dim jj As Integer

Dim cc As Integer

Dim c As Integer

Dim f As Integer

Dim k As Integer

u = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

Range("Q:CZ").ClearContents

For i = 5 To u

Cells(i, 17) = Trim("'" & Cells(i, 5) & Cells(i, 6) & "" & Cells(i, 7) & "" & Cells(i, 8) & "" & Cells(i, 9) & "" & Cells(i, 10) & "" & Cells(i, 11) & "" & Cells(i, 12) & "" & Cells(i, 13))

Next i

c = 18

f = u

k = 0

For j = 5 To u

If Trim(Cells(j, 17)) = "?" Then Exit For

If InStr(Cells(j, 17), "?") > 0 Then

zStr = Cells(j, 17)

lStr = Len(Cells(j, 17))

For jj = j To 5 Step -1

If Left(Cells(jj, 17), lStr - 1) = Left(zStr, lStr - 1) Then

Cells(f - k, c) = Cells(jj, 17)

k = k + 1

End If

Next jj

c = c + 1

k = 0

End If '''

Next j

Columns(17).ClearContents

q = c

For cc = c To 18 Step -1

If Cells(u - 1, cc) = "" Then

Columns(cc).EntireColumn.Delete

q = q - 1

End If

Next cc

Cells(1, 1).Select

Sheets("Output").Cells.ClearContents

For m = 18 To q

u1 = u

For n = u To 5 Step -1

If Sheets("Main").Cells(n, m) = "" Then

d = d + zL + 1

Exit For

End If

zL = Len(Sheets("Main").Cells(n, m))

For h = 1 To zL

Sheets("Output").Cells(u1, h + d) = Mid(Sheets("Main").Cells(n, m), h, 1)

Next h

u1 = u1 - 1

Next n

Next m

Sheets("main").Range("Q:CZ").ClearContents

Sheets("Output").Select

Cells(u, 1).Select

End Sub

Thank you in advance.