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.