Poll of numbers HELP!

[rhoknee]

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.


[VBA]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[/VBA]


Thank you in advance.

[mdmackillop]

Welcome to VBAX
Please repost your sample showing the expected outcome.
I can't see what you are trying to achieve here, so an overview would help us to understand.
It would be helpful to comment your code as to what each "block" is doing. Meaningful variables are also a great help in following a complicated code. We can work it out, but explanations make life easier for all, and it is good practise in any case.
Regards
MD

[rhoknee]

Sorry, I attached the wrong worksheet. I cannot comment on the code as I have no clue since I did not write it. I am trying to attach the illustrated version but I cannot find that allowance. Do I need to re-post?

[mdmackillop]

Just add another sheet to your workbook and move the data as you want to see it. Please also explain what the code is meant to do.

[rhoknee]

I have a matrix of numbers starting at columns B5 to I5. My task is to:
1) search through the matrix,from top to bottom looking for a row with a question mark "?". If I find it, then I look at all the rows above If I find any rows that have the first numbers as the one with the question mark, then I copy them 5 columns away from the main matrix. I those rows if they are more than 2. Only those rows with numbers similar up until the question mark point after the question mark it doesn't matter. I have illustrated this in my attachment. The first row I found was 0 0 0 0 0 0 0 ? but checking above, there where no similar rows so I moved down to the next row with a ? which was 0 3 0 0 1 0 ?, checking above that row I find that rows 9 and 6 have similar first numbers as 0 3 0 0 1 0..., so I copied them and row 12, 5 columns away.

2) I move down to another row with a question mark, which is row 25 and do the same thing. The rows with similar numbers at the beginning as those in row 25 are found in rows,8,16,17,21. I copy the results 3 rows below the one above. (See attachment for illustration).

Is it possible to have a macro that can do this for me as I have lots of large matrices to sort through?
Any help will be greatly appreciated
Thanks.

[mdmackillop]

[vba]
Option Explicit
Sub ListNums()
Dim Fnd As Range
Dim Res As Long
Dim c As Range
Dim Rng As Range
Dim txtFnd As String
Dim txt As String
Dim i As Long
Dim FirstAddress As String
Dim Col As Long
Dim cel As Range

Set Fnd = Range("B1")
Res = 6
FirstAddress = ""

Set c = Range("B:I").Find(What:="~?", After:=Fnd, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

Do
txtFnd = ""
If FirstAddress = "" Then FirstAddress = c.Address
Set Fnd = c
Col = c.Column - 2
Set Rng = Cells(c.Row, 2).Resize(, Col)
For Each cel In Rng
txtFnd = txtFnd & cel
Next
For i = 5 To c.Row
txt = ""
For Each cel In Cells(i, 2).Resize(, Col)
txt = txt & cel
Next
If txt = txtFnd Then
Cells(Res, 14).Resize(, 8).Value = Cells(i, 2).Resize(, 8).Value
Res = Res + 1
End If
Next i
Set c = Range("B:I").FindNext(c)
Res = Res + 3
Loop Until c.Address = FirstAddress
End Sub

[/vba]

[rhoknee]

Thanks a lot,the macro sorts out the second and the third set of matrices correctly but that is it. The last one was got wrong.
I greatly appreciate your time.

[mdmackillop]

If you need assistance, you'll need to provide more information.

[rhoknee]

I have tried to click on the consulting section and I have tried to upload my file with my requirement but I nothing is happening. Is there any other way to acquire the services of this site for a fee, exclusively for my problem?

[mdmackillop]

If you enable Private Messaging I'll contact you.

[rhoknee]

You may not believe this but I can not see where to enable private messaging!

[mdmackillop]

You'll find it under Quick Links/Edit Options

[rhoknee]

I have done it. Awaiting to hear from you.