Insert value intersect cell of equal row and column value

Shaun38 · Apr 26th 2016

Hi there,
If have the following issue which I keeps me awake the last days:

I have a in table form a Bill of Material (BOM) that consists out of 7 different headers, one of them is called "Part Number". in this header parts are numbered or named. These numbers (i.e. -1, -10, -13 ) can appear on the bottum of the table in the columns with the header "QTY"
I am searching for a vba code that goes through each number in the column "Part number" and search for this value in the columns with the header "QTY". If there is a match an "X" should be placed in the intersected cell.

Main issue: the amount of "QTY" columns differs, so in this example there are 4 QTY columns, but in other BOMs there might be more or less columns. As a result of this, the column Letter (this case Cell E1) of "Part Number" also varies.

If necesary I can change the header QTY by for example: QTY1 QTY2 QTY3 etc, to distinguish the QTY Columns.

Is there any way of how to approach my issue?

Thank you in advance,

Cheers Paul

See example below:
Old:
[TABLE="class: grid, width: 500, align: center"]

[tr]

[td]

QTY

[/td]

[td]

QTY

[/td]

[td]

QTY

[/td]

[td]

QTY

[/td]

[td]

Part Number

[/td]

[/tr]

[tr]

[td][/td]

[td]

-1

[/td]

[/tr]

[tr]

[td][/td]

[td]

1

[/td]

[td]

-10

[/td]

[/tr]

[tr]

[td][/td]

[td]

1

[/td]

[td]

-11

[/td]

[/tr]

[tr]

[td][/td]

[td]

2

[/td]

[td]

1

[/td]

[td][/td]

[td]

-13

[/td]

[/tr]

[tr]

[td][/td]

[td]

1

[/td]

[td][/td]

[td]

-20

[/td]

[/tr]

[tr]

[td]

4

[/td]

[td][/td]

[td]

-50

[/td]

[/tr]

[tr]

[td][/td]

[td]

3

[/td]

[td][/td]

[td]

Rivet

[/td]

[/tr]

[tr]

[td][/td]

[td]

6

[/td]

[td][/td]

[td]

Screw

[/td]

[/tr]

[tr]

[td]

-13

[/td]

[td]

-11

[/td]

[td]

-10

[/td]

[td]

-1

[/td]

[td]

(empty cell)

[/td]

[/tr]

[/TABLE]

NEW:

[TABLE="class: grid, width: 500, align: center"]

[tr]

[td]

QTY

[/td]

[td]

QTY

[/td]

[td]

QTY

[/td]

[td]

QTY

[/td]

[td]

Part Number

[/td]

[/tr]

[tr]

[td][/td]

[td]

X

[/td]

[td]

-1

[/td]

[/tr]

[tr]

[td][/td]

[td]

X

[/td]

[td]

1

[/td]

[td]

-10

[/td]

[/tr]

[tr]

[td][/td]

[td]

X

[/td]

[td][/td]

[td]

1

[/td]

[td]

-11

[/td]

[/tr]

[tr]

[td]

X

[/td]

[td]

2

[/td]

[td]

1

[/td]

[td][/td]

[td]

-13

[/td]

[/tr]

[tr]

[td][/td]

[td]

1

[/td]

[td][/td]

[td]

-20

[/td]

[/tr]

[tr]

[td]

4

[/td]

[td][/td]

[td]

-50

[/td]

[/tr]

[tr]

[td][/td]

[td]

3

[/td]

[td][/td]

[td]

Rivet

[/td]

[/tr]

[tr]

[td][/td]

[td]

6

[/td]

[td][/td]

[td]

Screw

[/td]

[/tr]

[tr]

[td]

-13

[/td]

[td]

-11

[/td]

[td]

-10

[/td]

[td]

-1

[/td]

[td]

(empty cell)

[/td]

[/tr]

[/TABLE]

**StephenR** · Apr 26th 2016

Re: Insert value intersect cell of equal row and column value

It's probably best if you post a workbook, but see if this works

Code

Sub x()


Dim r As Range, rFind As Range


With Range("A1").CurrentRegion
    For Each r In .Columns(.Columns.Count).Cells
        If IsNumeric(r.Value) Then
            Set rFind = .Resize(, .Columns.Count - 1).Find(What:=r, Lookat:=xlWhole)
            If Not rFind Is Nothing Then
                Intersect(r.EntireRow, rFind.EntireColumn).Value = "X"
                Set rFind = Nothing
            End If
        End If
    Next r
End With


End Sub

Display More

Shaun38 · Apr 27th 2016

Re: Insert value intersect cell of equal row and column value

Hi StephenR,

Thanks for your feedback, unfortunately your code doesnt execute any action. Therefor I post my workbook for an example, I made a small adjustment, namely:

- I ensured that always the Level-code is combined with the QTY (QTY-10, QTY-13 etc) , by doing this, the value in column "Y" - Part number, has only to be searched /matched with the header (so first row). I figured out that there is only a match (by using the search function) when typing: "*-number". i.e. *-1 or *-10 etc

I hope this helps,

Thank you in advance.

(Workbook is attached to my first post)

**StephenR** · Apr 27th 2016

Re: Insert value intersect cell of equal row and column value

I can see why my original code didn't do anything - a simple fix.

However your second post changes things slightly - are you saying that if the Part No is matched to a heading every value in that column should be replaced with X?

Shaun38 · Apr 27th 2016

Re: Insert value intersect cell of equal row and column value

Hi stephen,

No only the intersection. so when the header contains: "QTY-1" and the column Part Number contains "-1" than only in the intersected cell an X should be placed.

Shaun38 · Apr 27th 2016

Re: Insert value intersect cell of equal row and column value

Quote from StephenR;769964

I can see why my original code didn't do anything - a simple fix.

However your second post changes things slightly - are you saying that if the Part No is matched to a heading every value in that column should be replaced with X?

Hi stephen,

No only the intersection. so when the header contains: "QTY-1" and the column Part Number contains "-1" than only in the intersected cell an X should be placed.

**StephenR** · Apr 27th 2016

Re: Insert value intersect cell of equal row and column value

OK, try this (just remove the trailing space in Part Number):

Code

Sub x()
     
    Dim r As Range, rFind As Range, c As Long
     
    With Range("A1").CurrentRegion
        c = .Rows(1).Find(what:="Part Number", LookAt:=xlWhole, MatchCase:=False).Column
        For Each r In .Columns(c).Cells
            If IsNumeric(r.Value) Then
                Set rFind = .Rows(1).Resize(, c - 2).Find(what:="QTY" & Trim(r))
                If Not rFind Is Nothing Then
                    .Cells(r.Row, rFind.Column).Value = "X"
                    Set rFind = Nothing
                End If
            End If
        Next r
    End With
     
End Sub

Display More

Shaun38 · Apr 27th 2016

Re: Insert value intersect cell of equal row and column value

Hi Stephen,

It works flawless . Thank you very much for your quick support! Wish you a nice day

Kind regards Paul

Insert value intersect cell of equal row and column value

Participate now!

Share