if (xx in cell) - then insert (column title)

[Mignon]

Hello guys

I need help to
1) search for "xx" in the table
2) if "xx" is in the cell then insert column title.

Something like this:

To something like this:

TIA
Mignon

PS: I am new to Excel, working on Mac and cannot find out of programming yet, unless you can help me with step-by-step guide

 

[Mignon]

Re: Help needed: if (xx in cell) - then insert (column title)

From this:

date

w22

w12

CAG

PM

CT

MR

EKKO

SE/AE

Administration

FRIKØBT

Journalclub

Kongress

1

OK* AS**

CT SG

evt

MK/SK

IH

TH

KZ*

JD MH

EH

JJ HR MS JP

2

OK MH CV*

MS IH AP

evt

SH

JA

TS

JD AS

SK HD

JJ HR AH EH

3

IH*'

EH

JJ

4

JA**

IH

EH

<!--StartFragment--> <colgroup><col width="87" span="6" style="width:65pt"> <col width="87" style="width:65pt"> <col width="87" span="8" style="width:65pt"> </colgroup><tbody>
<!--EndFragment--></tbody>

To this:

date	EH
1	Journalclub
2	Kongress
3	w12
4	MR

<!--StartFragment--> <colgroup><col width="87" span="2" style="width:65pt"> </colgroup><tbody>
<!--EndFragment--></tbody>

 

[mumps]

Re: Help needed: if (xx in cell) - then insert (column title)

This macro assumes that the first table is in Sheet2 and the second table is in Sheet1. Copy and paste this macro into the worksheet code module. Do the following: right click the tab for your Sheet1 and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter a search value in cell B1 and exit the cell.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
    Dim sAddr As String
    Dim foundVal As Range
    Set foundVal = Sheets("Sheet2").UsedRange.Find(Target, LookIn:=xlValues, lookat:=xlPart)
    If Not foundVal Is Nothing Then
        sAddr = foundVal.Address
        Do
            Cells(Rows.Count, "B").End(xlUp).Offset(1, 0) = Sheets("Sheet2").Cells(1, foundVal.Column)
            Set foundVal = Sheets("Sheet2").UsedRange.FindNext(foundVal)
        Loop While foundVal.Address <> sAddr
        sAddr = ""
    End If
End Sub

This macro works on a PC. I'm not sure if it will work on a Mac.

 

[Mignon]

Re: Help needed: if (xx in cell) - then insert (column title)

Hi @mumps

Thank you for the fast reply!

I get following error message in a new window:

(approx. translation from danish) Error on 'runningtime': '9':
The index is out of area
​

Button options: Cancel Troubleshooting
​

When I press Troubleshooting, the code window opens and line 9
(with text: 'Set foundVal = Sheets("Sheet2").UsedRange.Find(Target, LookIn:=xlValues, lookat:=xlPart)')


is tagged with an arrow in the left side.

Do you have any idea how to solve it?

TIA
Mignon

 

[Mignon]

Re: Help needed: if (xx in cell) - then insert (column title)

Hi again mumps!

I found the solution! Since my Excel is in danish, sheet2 was named in danish.

Thank you!
Mignon

 

[mumps]

Re: Help needed: if (xx in cell) - then insert (column title)

You are very welcome.

 

[Mignon]

Re: Help needed: if (xx in cell) - then insert (column title)

You are very welcome.

An additional question:

how can I incorporate empty cells, so they are shown as empty in the result sheet? Right now are all the results with textstring in B1 listed without these empty spaces.

I have tried to fill the empty cells with '0', but it doesn't solve the problem so far.

 

[mumps]

Re: Help needed: if (xx in cell) - then insert (column title)

I'm not sure what you mean. Can you explain in detail using a few examples from your data and referring to specific cells, rows, columns and sheets?

 

[Mignon]

Re: Help needed: if (xx in cell) - then insert (column title)

If I take the example from above, if I want to search for 'HD' in cell B2 in sheet1, the correct result will be:

date	HD
1
2	FRIKØBT
3
4

<!--StartFragment--> <colgroup><col width="87" span="2" style="width:65pt"> </colgroup><tbody>
<!--EndFragment--></tbody>

since there is only one match from the sheet2. The empty cells should stay empty

 

[mumps]

Re: Help needed: if (xx in cell) - then insert (column title)

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
    Dim sAddr As String
    Dim foundVal As Range
    Set foundVal = Sheets("Sheet2").UsedRange.Find(Target, LookIn:=xlValues, lookat:=xlPart)
    If Not foundVal Is Nothing Then
        sAddr = foundVal.Address
        Do
            Cells(Sheets("Sheet2").Cells(foundVal.Row, 1).Value + 1, 2) = Sheets("Sheet2").Cells(1, foundVal.Column)
            Set foundVal = Sheets("Sheet2").UsedRange.FindNext(foundVal)
        Loop While foundVal.Address <> sAddr
        sAddr = ""
    End If
End Sub