Macro with filter criiteria

[XOLLI]

Hi,

I need some help, I am trying to create a macro where based on the data below it selects the values greater than 4 and then writes the rows and column in another part of the worksheet.

M1 M2 M3

M1 1 2 7

M2 8 1 9

M3 3 6 1



The macro then lists these as:

Item 1 Item 2
M1 M3
M2 M1
M2 M3
M3 M2


Any idea?


Thanks

 

[MickG]

Try this for results on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG17Mar13
 [COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nRay()
    Ray = ActiveSheet.Cells(1).CurrentRegion
     c = 1
        ReDim nRay(1 To 2, 1 To c)
            nRay(1, 1) = "Item1": nRay(2, 1) = "Item2"
[COLOR="Navy"]For[/COLOR] n = 2 To UBound(Ray, 1)
   [COLOR="Navy"]For[/COLOR] ac = 2 To UBound(Ray, 2)
        [COLOR="Navy"]If[/COLOR] Ray(n, ac) > 4 [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            ReDim Preserve nRay(1 To 2, 1 To c)
                nRay(1, c) = Ray(n, 1)
                nRay(2, c) = Ray(1, ac)
         [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 2)
    .Value = Application.Transpose(nRay)
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[XOLLI]

Hi Mick

Thanks for that, however I am receiving an error its says Run-time error '13'
Type Mismatch

 

[MickG]

Try comparing your Situation with this example file:-
https://app.box.com/s/bchrxo9kpzycp0e5gqiu3u4klfwsogqf

 

[XOLLI]

Thanks a lot!

Please can you explain how the function works so can use it for a similar example I have??

 

[MickG]

The Code:- If your data hasmore rows or more columns, it should not matter as the code takes care of that.

Inthe code "Ray" (at top of code) is an array of the Current Region starting "A1",that is the group/Area of cells that will cover all columns across starting column 1, until a blank column ismet and all rows down starting row 1, until a blank row is met.
Youdon't need to alter anything except perhaps the destination for the results(Sheet2) as shown at the bottom of the code.

Youcan try this for multi columns and multi rows as long as the basic format isthe same, it should work .