VBA fill column N depending on data column L

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,354
Office Version
  1. 2010
VBA fill column N depending on data column L

Hello,

Data are in cells B2:J3 I want to fill Column N based on data column L for example where is 2 in column L I want fill A|A value is above the 2, example where is 11 in column L I want fill A|B value is above the 11 and so on…

Example data


Book1
ABCDEFGHIJKLMN
1XYZABC
2ABCA|AA|BA|CA|DA|EA|FA|GA|HA|I2A|A
3XYZ2111350750212A|A
42A|A
52A|A
62A|A
72A|A
82A|A
92A|A
102A|A
112A|A
1211A|B
1311A|B
1411A|B
1511A|B
1611A|B
1711A|B
1811A|B
1911A|B
2011A|B
2111A|B
2211A|B
2311A|B
2411A|B
251A|C
261A|C
271A|C
281A|C
291A|C
301A|C
311A|C
321A|C
331A|C
341A|C
351A|C
361A|C
371A|C
381A|C
391A|C
401A|C
413A|D
423A|D
433A|D
443A|D
453A|D
463A|D
473A|D
483A|D
493A|D
505A|E
515A|E
525A|E
535A|E
545A|E
555A|E
565A|E
575A|E
587A|G
597A|G
607A|G
617A|G
627A|G
637A|G
647A|G
657A|G
667A|G
677A|G
6821A|I
6921A|I
7021A|I
7121A|I
7221A|I
Hoja1


Thank you all

Excel 2000
Regards,
Moti
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
USe

Code:
Sub MM1()
Dim c As Integer, lr As Long, r As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "L").End(xlUp).Row
For r = 2 To lr
    For c = 2 To 10
        If Cells(3, c).Value = Cells(r, 12) Then
            Cells(3, c).Offset(-1, 0).Copy
            Cells(r, 14).PasteSpecial Paste:=xlPasteAll
        End If
    Next c
Next r
Application.ScreenUpdating = True
End Sub
 
Upvote 0
MichaelM

Yours is much simpler than what I came up with...

Code:
Sub xPose()
Application.ScreenUpdating = False
Dim Dict    As Object
Dim vXYZ    As Range
Dim cel     As Range
Dim sLast   As String

Set Dict = CreateObject("scripting.dictionary")
Set hABC = Range("B2:J2")
Set hXYZ = Range("B3:J3")
Set vXYZ = Range("L2", Range("L" & Rows.Count).End(xlUp))

With Dict
    For Each cel In hXYZ
        If Not .exists(cel.Value) Then .Add cel.Value, cel.Offset(-1).Address
    Next cel
End With

For Each cel In vXYZ
    Range(Dict.Item(cel.Value)).Copy cel.Offset(, 2)
Next cel

Application.ScreenUpdating = True
End Sub
 
Upvote 0
Why not just use Index Match formulas instead of VBA?


N2:

<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px 'Lucida Grande'}span.s1 {color: #0057d6}span.s2 {color: #006107}span.s3 {color: #ab30d6}</style>=INDEX($B$2:$J$2, MATCH(L2,$B$3:$J$3,0))
 
Upvote 0
@tygrrboi
I think the OP wanted the formatting as well, which can only be done with VBA
 
Upvote 0
USe

Code:
Sub MM1()
Dim c As Integer, lr As Long, r As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "L").End(xlUp).Row
For r = 2 To lr
    For c = 2 To 10
        If Cells(3, c).Value = Cells(r, 12) Then
            Cells(3, c).Offset(-1, 0).Copy
            Cells(r, 14).PasteSpecial Paste:=xlPasteAll
        End If
    Next c
Next r
Application.ScreenUpdating = True
End Sub
Hello Michael M, your solution it perfects!! it is working nicely!! Your viewpoint is correct I wanted a solution with formatting as well thank you for your help

Regards,
Moti

 
Upvote 0
MichaelM

Yours is much simpler than what I came up with...

Code:
Sub xPose()
Application.ScreenUpdating = False
Dim Dict    As Object
Dim vXYZ    As Range
Dim cel     As Range
Dim sLast   As String

Set Dict = CreateObject("scripting.dictionary")
Set hABC = Range("B2:J2")
Set hXYZ = Range("B3:J3")
Set vXYZ = Range("L2", Range("L" & Rows.Count).End(xlUp))

With Dict
    For Each cel In hXYZ
        If Not .exists(cel.Value) Then .Add cel.Value, cel.Offset(-1).Address
    Next cel
End With

For Each cel In vXYZ
    Range(Dict.Item(cel.Value)).Copy cel.Offset(, 2)
Next cel

Application.ScreenUpdating = True
End Sub
Hello lrobbo314, it is working perfect!! thank you for your help

Regards,
Moti
 
Upvote 0
Why not just use Index Match formulas instead of VBA?


N2:

<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 12.0px 'Lucida Grande'}span.s1 {color: #0057d6}span.s2 {color: #006107}span.s3 {color: #ab30d6}</style>=INDEX($B$2:$J$2, MATCH(L2,$B$3:$J$3,0))
Hello tygrrboi, depend on each case in my case I wanted VBA because…


  1. I wanted if range vary update automatically
  2. Leave the value instead formula is running all the time
  3. Wanted a formatting as well
  4. This was a example so if working with large range formula some time do not respond depending on each computer

Thank you for your help

Regards,
Moti

 
Upvote 0
Hello tygrrboi, depend on each case in my case I wanted VBA because…


  1. I wanted if range vary update automatically
  2. Leave the value instead formula is running all the time
  3. Wanted a formatting as well
  4. This was a example so if working with large range formula some time do not respond depending on each computer

Thank you for your help

Regards,
Moti

Hello tygrrboi, I were wrong finally I am using your formula in VBA because it result quicker!!
Code:
Sub tygrrboi()
   
    Dim t As Date
    t = Now()
    Range("N2:N65500").Select
    Selection.ClearContents
    Range("N2").Select
    
    Dim lngLastRow As Long
    lngLastRow = Cells(Rows.Count, "L").End(xlUp).Row
'------------------------------------------------------------------------------------------------
    Range("N2:N" & lngLastRow).Formula = "=INDEX($B$2:$J$2,MATCH(L2,$B$3:$J$3,0))"
    Range("N2:N" & lngLastRow) = Range("N2:N" & lngLastRow).Value
    
    MsgBox Format(Now() - t, "hh:mm:ss")
End Sub

Regards,
Moti
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top