Vlookup and Get comments ( Macro or VBA or magic)

OrochiNoob

New Member
Joined
May 8, 2019
Messages
20
Hello to all

So Im trying to accomplish 2 things, I have a table that was poorly formatted were I need to get information 50+ times a day
I was able to get the information but there are comments on SOME cells,

This is what I got so far
1st DropDown ( Main Category )
2nd Indirect Dropdown ( Second Category )

Vlookup to look for the Indirect result

I need help getting the comments from the Vllokup result to and adjacent cell


A
1 Main Drop Selection
2 Indirect DropdownSelection

A B C
10 Field1 Vlookup Indirect DropdownSelection / Comments TO STRING original Cell
11 Field2 Vlookup Indirect DropdownSelection / Comments TO STRING original Cell
12 Field3 Vlookup Indirect DropdownSelection / Comments TO STRING original Cell
13 Field4 Vlookup Indirect DropdownSelection / Comments TO STRING original Cell


C10:C13 Are missing

Super Thank you in advanced
 
It only occurs to me, that in the "origin" sheet you have cells with blank spaces.
 
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
The macro works according to your images.
I'm here asking again for your help :)

Can you help add an extra function, I have tried to update the function but obviously I failed
Almost same thing, when B9 is updated in "Reformatted", I need to copy only the contents from another cell ( since this field does not contain any comments)

In essence Keep previous function and add extra search and copy from another sheet (origin2)


Original code ( updated since I moved cells to add this new feature )

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.CountLarge > 1 Then Exit Sub
  If Target.Value = "" Then Exit Sub
  
  If Target.Address(0, 0) = "B9" Then
    Dim sh As Worksheet, f As Range, j As Long, i As Long
    
    i = 3
    Range("K3:L17").ClearContents
    
    Set sh = Sheets("Origin")
    Set f = sh.Range("C4:C70").Find(Target, , xlValues, xlWhole)
    If Not f Is Nothing Then
      For j = Columns("D").Column To Columns("R").Column
        Cells(i, "K").Value = sh.Cells(f.Row, j).Value
        If Not sh.Cells(f.Row, j).Comment Is Nothing Then
          Cells(i, "L").Value = sh.Cells(f.Row, j).Comment.Text
        End If
        i = i + 1
      Next
    End If
  End If
End Sub


Copypasted and edited one

VBA Code:
 Private Sub Worksheet_Change2(ByVal Target1 As Range)
  If Target1.CountLarge > 1 Then Exit Sub
  If Target1.Value = "" Then Exit Sub
 
  If Target1.Address(0, 0) = "B9" Then
    Dim sh1 As Worksheet, q As Range, w As Long, e As Long
 
    e = 3
    Range("F3:G12").ClearContents
 
    Set sh1 = Sheets("Origin2")
    Set q = sh1.Range("C5:C70").Find(Target1, , xlValues, xlWhole)
    If Not f Is Nothing Then
      For w = Columns("D").Column To Columns("M").Column
        Cells(e, "F").Value = sh1.Cells(q.Row, w).Value
        If Not sh1.Cells(q.Row, w).Comment Is Nothing Then
          Cells(e, "G").Value = sh1.Cells(q.Row, w).Comment.Text
        End If
        e = e + 1
      Next
    End If
  End If
End Sub
 
Upvote 0
There is only one Change event.


The macro already works for you or you need something additional.
The original macro works like a charm, I was hoping to edit the one you send to accommodate my future needs , but I failed hard

The "new" requirement"

Additionally to what the previous Change Event did when Cell B9 in "Reformatted" sheet is updated, now it has to do another lookup ( no comments just contents ) in sheet Origin2 and pasted them in Reformatted F3:F12

So Lookup Reformatted B9 content in Origin2 C6:M65
Paste to F3:F32


Thank you!!
 
Upvote 0
Try this:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.CountLarge > 1 Then Exit Sub
  If Target.Value = "" Then Exit Sub
  
  If Target.Address(0, 0) = "B9" Then
    Dim sh As Worksheet, f As Range, j As Long, i As Long
    Dim sh2 As Worksheet
    
    i = 3
    Range("K3:L17").ClearContents
    
    Set sh = Sheets("Origin")
    
    Set f = sh.Range("C4:C70").Find(Target, , xlValues, xlWhole)
    If Not f Is Nothing Then
      For j = Columns("D").Column To Columns("R").Column
        Cells(i, "K").Value = sh.Cells(f.Row, j).Value
        If Not sh.Cells(f.Row, j).Comment Is Nothing Then
          Cells(i, "L").Value = sh.Cells(f.Row, j).Comment.Text
        End If
        i = i + 1
      Next
    End If
    
    i = 3
    Set sh2 = Sheets("Origin")
    Set f = sh2.Range("C5:C70").Find(Target, , xlValues, xlWhole)
    If Not f Is Nothing Then
      For j = Columns("D").Column To Columns("M").Column
        Cells(i, "F").Value = sh2.Cells(f.Row, j).Value
        If Not sh2.Cells(f.Row, j).Comment Is Nothing Then
          Cells(i, "G").Value = sh2.Cells(f.Row, j).Comment.Text
        End If
        i = i + 1
      Next
    End If
    
  End If
End Sub

Some tips:
It is customary to use the same letters for variables, for example:
f for Find
i for the rows
j for the columns.
Each programmer has his style, but there is an unwritten "rule" to use "i" for rows.
 
Upvote 0
Try this:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.CountLarge > 1 Then Exit Sub
  If Target.Value = "" Then Exit Sub
 
  If Target.Address(0, 0) = "B9" Then
    Dim sh As Worksheet, f As Range, j As Long, i As Long
    Dim sh2 As Worksheet
   
    i = 3
    Range("K3:L17").ClearContents
   
    Set sh = Sheets("Origin")
   
    Set f = sh.Range("C4:C70").Find(Target, , xlValues, xlWhole)
    If Not f Is Nothing Then
      For j = Columns("D").Column To Columns("R").Column
        Cells(i, "K").Value = sh.Cells(f.Row, j).Value
        If Not sh.Cells(f.Row, j).Comment Is Nothing Then
          Cells(i, "L").Value = sh.Cells(f.Row, j).Comment.Text
        End If
        i = i + 1
      Next
    End If
   
    i = 3
    Set sh2 = Sheets("Origin")
    Set f = sh2.Range("C5:C70").Find(Target, , xlValues, xlWhole)
    If Not f Is Nothing Then
      For j = Columns("D").Column To Columns("M").Column
        Cells(i, "F").Value = sh2.Cells(f.Row, j).Value
        If Not sh2.Cells(f.Row, j).Comment Is Nothing Then
          Cells(i, "G").Value = sh2.Cells(f.Row, j).Comment.Text
        End If
        i = i + 1
      Next
    End If
   
  End If
End Sub

Some tips:
It is customary to use the same letters for variables, for example:
f for Find
i for the rows
j for the columns.
Each programmer has his style, but there is an unwritten "rule" to use "i" for rows.
My day just got brighter with that code, it works perfectly
A great tips, that makes a lot of sense !
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,191
Members
452,616
Latest member
intern444

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