Finding relation between different cells of each row

[near]

hi

 

[near]

I can only copy few data as a sample....but as i told you earlier, my actual data is very big...
Sheet3 data is like this:

100
101
102
200
201
202
203
300
302
301
303
401
402
403
500
501
502
503
400
103


And Sheet1 data is like this:


100 101 102 103
200 201 202 203
300 301 302 303
400 401 402 403
500 501 502 503

Now, you can see that in Sheet1, my data consists of 5 rows and 4 columns, but my actual data includes 600 rows and 50 columns

 

[MickG]

I enlarged sheet3 data to 50 columns and 600 rows and ran against sheet1 data.
The Results were on sheet 2 after about 15 secs, not sure how accurate they are !!!

[COLOR="Navy"]Sub[/COLOR] MG17Apr28
[COLOR="Navy"]Dim[/COLOR] Lst  [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Mc   [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac  [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rw   [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng  [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Mr   [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dr
[COLOR="Navy"]Dim[/COLOR] K
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] DataRay
[COLOR="Navy"]Dim[/COLOR] DRng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]With[/COLOR] Sheets("Sheet3")
    [COLOR="Navy"]Set[/COLOR] DRng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
     DRng.Copy .Range("Z1")
      .Range("Z1").Resize(DRng.Count).Sort .Range("Z1"), xlAscending
       DataRay = .Range("Z1").Resize(DRng.Count)
        .Range("Z1").Resize(DRng.Count).ClearContents
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Rng = Sheets("Sheet1").Range("A1").CurrentRegion
   MsgBox Rng.Address
   ReDim Ray(1 To DRng.Count + 1, 1 To DRng.Count + 1)
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dr [COLOR="Navy"]In[/COLOR] DataRay
                Ac = Ac + 1
                Ray(1, Ac + 1) = Dr
                Ray(Ac + 1, 1) = Dr
            [COLOR="Navy"]Next[/COLOR] Dr
ReDim oMax(1 To Rng.Rows.Count)
[COLOR="Navy"]For[/COLOR] Mr = 2 To UBound(Ray, 1)
    [COLOR="Navy"]For[/COLOR] Mc = 2 To UBound(Ray, 2)
       [COLOR="Navy"]For[/COLOR] Rw = 1 To Rng.Rows.Count
            [COLOR="Navy"]With[/COLOR] Application
                oMax(Rw) = .CountIf(Rng.Rows(Rw), Ray(1, Mc)) + .CountIf(Rng.Rows(Rw), Ray(Mr, 1))
            [COLOR="Navy"]End[/COLOR] With
       [COLOR="Navy"]Next[/COLOR] Rw
       Ray(Mr, Mc) = IIf(Application.Max(oMax) = 2, 1, 0)
    [COLOR="Navy"]Next[/COLOR] Mc
[COLOR="Navy"]Next[/COLOR] Mr
Sheets("Sheet2").Range("A1").Resize(DRng.Count + 1, DRng.Count + 1) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[near]

I told you that data on Sheet3 is only on A column. You can see my last post...
Here it is
100
101
102
200
201
202
203
300
302
301
303
401
402
403
500
501
502
503
400
103


This data is the unique list of all the data in Sheet1 (Unique means every value will occur only one time in sheet3)

And Sheet1 data is like this:


100 101 102 103
200 201 202 203
300 301 302 303
400 401 402 403
500 501 502 503

Here 101 may occur in any row or any column one or more times.....but in Sheet3, it will occur only one time...

 

[MickG]

Sorry the code is right, my sentence is incorrect, The single column Data is as you say on sheet 3 with the 50 col 600 rows on sheet 1.
Nb:- If a value in any single row in sheet3 can appear more than onces in that row, then the code will need altering !!, is that the case ???

 

[near]

No alert is required....because the data on sheet3 will be provided by me and it will always be unique. because i already processed sheet1 and extracted unique values.

 

[near]

Now, i run this code on 1045 rows and 60 columns data....and got the same error message "out of memory"

This is my maximum limit of data.....can you modify it little more to adjust this range...?

 

[near]

Please tell me One more thing related to this solution...

If the data in Sheet1 appears like this,

100 101 102
200 201 202

And the data in Sheet3 appears like this,

100
101
102
200
201
202

Now, If I change a relationship definition.
If I say only 101 and 102 are related to 100 but not related to each other. (relationship only holds between the row heading and other entries of same row)
and 201 and 202 are related to 200 but not related to each other.
Then what should i change in code?
Thanks again

 

[MickG]

I don't see why you can't run this in two goes, although my Ancient computer managed it.!!
Where you see the Line

Set Rng = Sheets("Sheet1").Range("A1").CurrentRegion

You need to run two code with half the total range in each.
So the first code might look like this:-

Set Rng = Sheets("Sheet1").Range("A1:AX500")
'and the second like
Set Rng = Sheet("Sheet1").range("A501:AX1045")

'''''''''''''''''''
With regard to you other quetion, At the moment the Code looks at each matrix (Column) headers with each Matric (Row) header , Which are made up from Sheet3.
The code checks to see whether the "Row" Header value and the "Column" Header value are both, in one of the rows in sheet1, If both the value are in one row then the matrix gets a "1", else a "0".
Does you new criteria mean that instead of checking the entire row it checks The two matrix Col/Row headers, against the first value in any row of sheet 1, with each of the subsequent values in that row.
So in effect you are check 2 values Matrix Col/Row headers, against 2 other values, of each row of sheet1.
This is getting complicated !!!!