Finding column & row headers for each showing of specific text in a table of data

**stwilson** · 05-06-2012, 02:57 PM

I'm stuck. I'm trying to find the best approach to analyze a table of data. My table of data consists of data that includes:

two letter acronyms. For example, RB, FA, CU, etc.
the table of data is randomly generated
each column has a set column header (two digit number)
each row has a set row header (one digit number)

What I am trying to accomplish is a VBA or macro to scan the predefined table and to list EVERY column/row headers where each specific two letter acronym exists. I need the column/row header combined in a single cell (not cell column/row but the headers) for each showing in the table of data. Some two letter acronyms may show more than others. I'm attaching a sample file that I hope helps better explain what I am trying to do. I appreciate any help the community can offer.

Sample File.xlsx

**mrice** · 05-06-2012, 03:47 PM

Try this

Sub Test()
For N = 2 To Cells(1, 1).CurrentRegion.Rows.Count
    For M = 2 To Cells(1, 1).CurrentRegion.Columns.Count
        If WorksheetFunction.CountIf(Columns(Cells(1, 1).CurrentRegion.Columns.Count + 2), Cells(N, M).Value) = 0 Then
            Cells(Rows.Count, Cells(1, 1).CurrentRegion.Columns.Count + 2).End(xlUp).Offset(1, 0) = Cells(N, M).Value
        End If
        TargetRow = Columns(Cells(1, 1).CurrentRegion.Columns.Count + 2).Find(Cells(N, M), , xlValues, xlWhole).Row
        Cells(TargetRow, Columns.Count).End(xlToLeft).Offset(0, 1) = "'" & Cells(1, M) & Cells(N, 1)
    Next M
Next N
End Sub

**stwilson** · 05-06-2012, 05:12 PM

MrIce...thank you so much for your reply. I have a couple of questions, just so I understand how to use the code you supplied. How do I control what columns/rows the code you supplied will look at? In my sample...I only included a small set of data. My true table is much wider and has more rows. I want to have your code push the results to another tab in my spreadsheet. How would I accomplish this?

**mrice** · 05-06-2012, 05:51 PM

The code should put the data to the left of the columns of original data however many you have.

For a separate sheet, use something like...

Sub Test()
For N = 2 To Cells(1, 1).CurrentRegion.Rows.Count
    For M = 2 To Cells(1, 1).CurrentRegion.Columns.Count
        If WorksheetFunction.CountIf(Sheets(2).Columns(1), Cells(N, M).Value) = 0 Then
            Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Cells(N, M).Value
        End If
        TargetRow = Sheets(2).Columns(1).Find(Cells(N, M), , xlValues, xlWhole).Row
        Sheets(2).Cells(TargetRow, Columns.Count).End(xlToLeft).Offset(0, 1) = "'" & Cells(1, M) & Cells(N, 1)
    Next M
Next N
End Sub

**stwilson** · 05-06-2012, 06:03 PM

Thank you again for your reply MrIce. Can you see this sample file and explain how I would get the macro to pull the data from the Data tab and push it to the Out tab? I put a Macro button on the Data tab but was getting errors in trying to get your supplied code to push the results to the Out tab. Can you help?Sample File II.xlsm

**stwilson** · 05-06-2012, 07:09 PM

Martin,

Can you PM me your PayPal address. I would like to shoot you a thank you for your time.

**stwilson** · 05-07-2012, 02:16 AM

Martin,

I believe I figured out most of it. I have one final question I hope you can help me with. For the results derived from the code you provided to generate data in a new tab: is it possible to cap the results at a set number, for example, say 30 results, and have results 30-59 go to the next line? My table of data will produce a couple of acronyms that will have more results than can fit on one line, causing the output to stretch to two pages. What I am trying to do for those acronyms is have it push to line #2 after X number of results, so I can keep the results to one page. Is that possible?

**mrice** · 05-07-2012, 10:18 AM

Hi

Try this version


Sub Test()
For N = 2 To Cells(1, 1).CurrentRegion.Rows.Count
    For M = 2 To Cells(1, 1).CurrentRegion.Columns.Count
        If WorksheetFunction.CountIf(Sheets("Out").Columns(1), Cells(N, M).Value) = 0 Then
            Sheets("Out").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Cells(N, M).Value
        End If
        TargetRow = Sheets(2).Columns(1).Find(Cells(N, M), , xlValues, xlWhole).Row
        Sheets("Out").Cells(TargetRow, Columns.Count).End(xlToLeft).Offset(0, 1) = "'" & Cells(1, M) & Cells(N, 1)
    Next M
Next N

'Tidy up
MaxNumber = 30
Sheets("Out").Activate
For N = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    Do While Cells(N, Columns.Count).End(xlToLeft).Column > MaxNumber + 1
        Rows(N + 1).Insert
        Cells(N + 1, 1) = Cells(N, 1)
        If (Cells(N, Columns.Count).End(xlToLeft).Column - 1) Mod MaxNumber > 0 Then
            Range(Cells(N, Cells(N, Columns.Count).End(xlToLeft).Column + 1 - (Cells(N, Columns.Count).End(xlToLeft).Column - 1) Mod MaxNumber), Cells(N, Columns.Count)).Cut Destination:=Cells(N + 1, 2)
        Else
            Range(Cells(N, Cells(N, Columns.Count).End(xlToLeft).Column + 1 - MaxNumber), Cells(N, Columns.Count)).Cut Destination:=Cells(N + 1, 2)
        End If
    Loop

Next N

End Sub

**stwilson** · 05-07-2012, 12:03 PM

Martin,

Thank you for your reply. When using the above code...I get the following error:

"Run-time error '91': Object variable or With block variable not set"

It is referencing this line of code: TargetRow = Sheets(2).Columns(1).Find(Cells(N, M), , xlValues, xlWhole).Row

Any suggestions?

**stwilson** · 05-07-2012, 01:46 PM

I figured out what the issue was....auto calculation of the sheet was enabled and it was causing the error.

I do have one other question...is there a way to order the results from smallest to largest, so the results are in order?

**mrice** · 05-07-2012, 02:47 PM

What do you mean by small and large - is it the number of times they occur or something else?

**stwilson** · 05-07-2012, 03:10 PM

Martin,

If you look at my original sample file, you will see the following listed under my results desired:

FA 011 021 031 033

Your code is spitting out the results accurately but with my larger set of data (much bigger than sample) I would like to numbers to be listed in order from smallest to largest, if possible. I believe the code you supplied is listing them in order by which they are found row by row. Is it possible to list them in order from smallest number to largest?

**mrice** · 05-07-2012, 03:30 PM

If the lines of code are rearranged thus...

Sub Test()
For M = 2 To Cells(1, 1).CurrentRegion.Columns.Count
    For N = 2 To Cells(1, 1).CurrentRegion.Rows.Count
    
        If WorksheetFunction.CountIf(Sheets("Out").Columns(1), Cells(N, M).Value) = 0 Then
            Sheets("Out").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Cells(N, M).Value
        End If
        TargetRow = Sheets(2).Columns(1).Find(Cells(N, M), , xlValues, xlWhole).Row
        Sheets("Out").Cells(TargetRow, Columns.Count).End(xlToLeft).Offset(0, 1) = "'" & Cells(1, M) & Cells(N, 1)
    Next N
Next M
'Tidy up
MaxNumber = 30
Sheets("Out").Activate
For N = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    Do While Cells(N, Columns.Count).End(xlToLeft).Column > MaxNumber + 1
        Rows(N + 1).Insert
        Cells(N + 1, 1) = Cells(N, 1)
        If (Cells(N, Columns.Count).End(xlToLeft).Column - 1) Mod MaxNumber > 0 Then
            Range(Cells(N, Cells(N, Columns.Count).End(xlToLeft).Column + 1 - (Cells(N, Columns.Count).End(xlToLeft).Column - 1) Mod MaxNumber), Cells(N, Columns.Count)).Cut Destination:=Cells(N + 1, 2)
        Else
            Range(Cells(N, Cells(N, Columns.Count).End(xlToLeft).Column + 1 - MaxNumber), Cells(N, Columns.Count)).Cut Destination:=Cells(N + 1, 2)
        End If
    Loop

Next N

End Sub

... the values appear in ascending order but only because the row and column headers are in ascending order themselves - will this always be the case?

**stwilson** · 05-07-2012, 04:00 PM

Martin,

That did it! The columns/rows will always be in ascending order.

Is there any way to have the two letter acronyms listed in alphabetical order too? That would put the results in alphabetical order, with the numbers listed to the right from smallest to largest.

I will mark this thread as Solved and will PayPal you a thank you for your time. I REALLY appreciate it!!

**mrice** · 05-07-2012, 04:47 PM

Additional line added to perform sorting.

Sub Test()
For M = 2 To Cells(1, 1).CurrentRegion.Columns.Count
    For N = 2 To Cells(1, 1).CurrentRegion.Rows.Count
    
        If WorksheetFunction.CountIf(Sheets("Out").Columns(1), Cells(N, M).Value) = 0 Then
            Sheets("Out").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Cells(N, M).Value
        End If
        TargetRow = Sheets(2).Columns(1).Find(Cells(N, M), , xlValues, xlWhole).Row
        Sheets("Out").Cells(TargetRow, Columns.Count).End(xlToLeft).Offset(0, 1) = "'" & Cells(1, M) & Cells(N, 1)
    Next N
Next M

'Tidy up

MaxNumber = 30
Sheets("Out").Activate
Cells(2, 1).CurrentRegion.Sort Key1:=Cells(2, 1), order1:=xlAscending
For N = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    Do While Cells(N, Columns.Count).End(xlToLeft).Column > MaxNumber + 1
        Rows(N + 1).Insert
        Cells(N + 1, 1) = Cells(N, 1)
        If (Cells(N, Columns.Count).End(xlToLeft).Column - 1) Mod MaxNumber > 0 Then
            Range(Cells(N, Cells(N, Columns.Count).End(xlToLeft).Column + 1 - (Cells(N, Columns.Count).End(xlToLeft).Column - 1) Mod MaxNumber), Cells(N, Columns.Count)).Cut Destination:=Cells(N + 1, 2)
        Else
            Range(Cells(N, Cells(N, Columns.Count).End(xlToLeft).Column + 1 - MaxNumber), Cells(N, Columns.Count)).Cut Destination:=Cells(N + 1, 2)
        End If
    Loop

Next N

End Sub

**stwilson** · 05-14-2012, 06:17 PM

Martin,

That did it. Thank you. Three small questions.

1. How do I get the order of the columns to be alphabetical? A -> Z?
2. How do I push the results down to row two, instead of row 1?
3. How do I push the results left to column #1, instead of column #2?

Thank you kindly for your help.

**mrice** · 05-14-2012, 11:07 AM

If the data is transposed, use the following code

Sub Test()
For M = 2 To Cells(1, 1).CurrentRegion.Columns.Count
    For N = 2 To Cells(1, 1).CurrentRegion.Rows.Count
    
        If WorksheetFunction.CountIf(Sheets("Out").Columns(1), Cells(N, M).Value) = 0 Then
            Sheets("Out").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = Cells(N, M).Value
        End If
        If Cells(N, M).Value <> "" Then
            TargetRow = Sheets("Out").Columns(1).Find(Cells(N, M), , xlValues, xlWhole).Row
            Sheets("Out").Cells(TargetRow, Columns.Count).End(xlToLeft).Offset(0, 1) = "'" & Cells(N, 1) & Cells(1, M)
        End If
    Next N
Next M

'Tidy up

MaxNumber = 30
Sheets("Out").Activate
Cells(2, 1).CurrentRegion.Sort Key1:=Cells(2, 1), order1:=xlAscending
For N = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    Do While Cells(N, Columns.Count).End(xlToLeft).Column > MaxNumber + 1
        Rows(N + 1).Insert
        Cells(N + 1, 1) = Cells(N, 1)
        If (Cells(N, Columns.Count).End(xlToLeft).Column - 1) Mod MaxNumber > 0 Then
            Range(Cells(N, Cells(N, Columns.Count).End(xlToLeft).Column + 1 - (Cells(N, Columns.Count).End(xlToLeft).Column - 1) Mod MaxNumber), Cells(N, Columns.Count)).Cut Destination:=Cells(N + 1, 2)
        Else
            Range(Cells(N, Cells(N, Columns.Count).End(xlToLeft).Column + 1 - MaxNumber), Cells(N, Columns.Count)).Cut Destination:=Cells(N + 1, 2)
        End If
    Loop

Next N

End Sub

**stwilson** · 05-14-2012, 01:51 PM

Martin,

That did not work. What I am attempting to accomplish is to generate the following by swapping the rows and columns:

Acronym A Acronym B Acronym C
011 201 014
210 311 113

I would like the acronyms listed horizontally across the top (columns), with a row for each showing of that acronym in the table. I would like the rows of data to go from smallest to largest (this would be vertically). This would push the data down the page, as opposed to across the page. Does that make sense?

**stwilson** · 05-14-2012, 01:57 PM

Sorry. My sample mentioned above did not display very well. Trying again.

AA AB AC AD
102 103 124 111
104 105 212 412
141 143 225 413
303 205 252 454
503 302 305
323 353
444 404
411
415

**mrice** · 05-14-2012, 04:21 PM

Try this.

Sub Test()
For M = 2 To Cells(1, 1).CurrentRegion.Columns.Count
    For N = 2 To Cells(1, 1).CurrentRegion.Rows.Count
        If WorksheetFunction.CountIf(Sheets("Out").Rows(1), Cells(N, M).Value) = 0 Then
            Sheets("Out").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) = Cells(N, M).Value
        End If
        TargetColumn = Sheets(2).Rows(1).Find(Cells(N, M), , xlValues, xlWhole).Column
        Sheets("Out").Cells(Rows.Count, TargetColumn).End(xlUp).Offset(1, 0) = "'" & Cells(1, M) & Cells(N, 1)
    Next N
Next M

'Tidy up

Sheets("Out").Activate
Rows(1).Insert
Range(Cells(1, 2), Cells(2, Columns.Count).End(xlToLeft).Offset(-1, 0)).FormulaR1C1 = "=COUNTA(R[1]C:R[1048574]C)"

Cells(1, 2).CurrentRegion.Sort Key1:=Cells(1, 2), order1:=xlDescending, Orientation:=xlLeftToRight


Rows("1:1").Delete Shift:=xlUp


End Sub

**mrice** · 05-15-2012, 04:42 AM

Assuming that order of the columns means order within each column, please try this.

Sub Test()
For M = 2 To Cells(1, 1).CurrentRegion.Columns.Count
    For N = 2 To Cells(1, 1).CurrentRegion.Rows.Count
        If WorksheetFunction.CountIf(Sheets("Out").Rows(1), Cells(N, M).Value) = 0 Then
            Sheets("Out").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) = Cells(N, M).Value
        End If
        TargetColumn = Sheets(2).Rows(1).Find(Cells(N, M), , xlValues, xlWhole).Column
        Sheets("Out").Cells(Rows.Count, TargetColumn).End(xlUp).Offset(1, 0) = "'" & Cells(1, M) & Cells(N, 1)
    Next N
Next M

'Tidy up

Sheets("Out").Activate
Rows(1).Insert
Range(Cells(1, 2), Cells(2, Columns.Count).End(xlToLeft).Offset(-1, 0)).FormulaR1C1 = "=COUNTA(R[1]C:R[1048574]C)"

Cells(1, 2).CurrentRegion.Sort Key1:=Cells(1, 2), order1:=xlDescending, Orientation:=xlLeftToRight
Rows("1:1").ClearContents

Columns(1).Delete
For N = 1 To Cells(2, Columns.Count).End(xlToLeft).Column
    Range(Cells(2, N), Cells(2, N).End(xlDown)).Sort Key1:=Cells(2, N), order1:=xlAscending, Header:=xlYes
Next N
End Sub

Finding column & row headers for each showing of specific text in a table of data

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Re: Finding column & row headers for each showing of specific text in a table of data

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions