how to find a value and copy remark, author, row and column header names to new sheet

[Brandweerman]

Hello,


i'm struggling with a problem for some time now.

i'm scheduling a 2 year exercise plan for the 30 fire stations in my region.
It is to big for people to extract their data to work with.
Therefore i want to create a list with a specific search value: put in the value from a drop down list and hit a button to execute the macro.


I would like to find a VBA code that will search for every value (by user input in the sheet cell with a pre-defined list) to search row by row in the range F12:SH191 and then copy:
1) the remark (note in Office 365) from the cell with that value
2) the author of that remark/note
3) the group name of the corresponding row cell in Column E12:E191
4) The schedule date of the corresponding column cell in row F4:SH4


these 4 variables should be placed on a new sheet
where the column names are in row 2 named:


chknr Date(4) group(3) note(1) author(2)


so the first value items set to row 3 then 4, etc.


chknr is a follow up number 1 to ...


Thanks in advance

With kind regards,

Ben

[Paul_Hossler]

Probably do-able, but an example workbook with some input and a hand generated example of your desired output would be most helpful.

Attach instructions are in my signature

[Brandweerman]

The file uploaded has no code, what i had is a beginning of the declarations but that was not really something to inclose.

until i take a proper course in VBA, i have to search for code that i can change to my wishes.

Still hope you can help.

[p45cal]

try:

Sub blah()
With Sheets("Overview")
  SearchItm = .Range("C1").Value
  Set Destn = .Range("A3")
  chknr = 0

  'delete destination area:
  If Len(Destn.Value) > 0 Then Range(.Cells(.Rows.Count, 1).End(xlUp), Destn).Resize(, 5).ClearContents
End With
With Sheets("Plan sheet")
  For Each cll In .Range("F13:SH191")
    If cll.Value = SearchItm Then
      chknr = chknr + 1
      If cll.Comment Is Nothing Then
        myComment = Empty: myAuthor = Empty
      Else
        myComment = cll.Comment.Text
        myAuthor = cll.Comment.Author
      End If
      myGroup = .Cells(cll.Row, "E").Value
      myDate = .Cells(4, cll.Column).Value
      Destn.Resize(, 5).Value = Array(chknr, myDate, myGroup, myComment, myAuthor)
      Set Destn = Destn.Offset(1)
    End If
  Next cll
End With
End Sub

[Brandweerman]

Hello p45cal,

I'm thrilled with this solution. It is exactly how i wanted it.
Really need to learn these skills myself.
Love it!! Thank you very much!

Greetings Ben.