Vlookup and Get comments ( Macro or VBA or magic)

[OrochiNoob]

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

 

[DanteAmor]

It only occurs to me, that in the "origin" sheet you have cells with blank spaces.

 

[OrochiNoob]

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 )

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

 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

 

[OrochiNoob]

It only occurs to me, that in the "origin" sheet you have cells with blank spaces.

That was exactly it ! , since the list is changing one or twice a week the cells sometimes are missedited,

 

[DanteAmor]

Worksheet_Change

There is only one Change event.

That was exactly it ! , since the list is changing one or twice a week the cells sometimes are missedited,

The macro already works for you or you need something additional.

 

[OrochiNoob]

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!!

 

[DanteAmor]

Try this:

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.

 

[OrochiNoob]

Try this:

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 !

 

[DanteAmor]

Again with pleasure. Thanks for the feedback