VBA - Show cell comments for a specific range of cells based on date, in a table format

[celebwen_orn]

I have two worksheets. One is the source worksheet, where all my data and comments are added, the other is a Report worksheet, which takes the necessary subset of data it needs (there are a few different report workbooks, all taking data, this data changes each week according to resourcing requirements). The Source worksheet has Names down the B column, and Dates across Row 4, with positions allocated in the table. Sometimes there are comments against those positions.

I need to be able to look at a weeks worth of data, and take any comments against these cells to give a print out of them in table format. The table needs to have the format: Date, Name, Cell Value (aka resource position), Cell Comment. Not the typical 'Address' command as this is not helpful. The week in question is determined by the dates which are input at the top of the Report worksheet, these are entered as a formula (i.e =TODAY()+7-WEEKDAY(TODAY()+7-2) for the Monday and then every other day as a plus 1). I'm not sure if this will cause me issues.

I'm (highly) inexperienced at VBAing and have come up with a (highly fail) code as below, with heaps of bugs (most likely) which I need help fixing up to return the above result. I've put in comments to try explain what I'm attempting to do with each row as it's probably not obvious.

Any help would be appreciated, especially with explanations as to why as I really am trying to understand and learn it!

Sub showcomments()
Dim ShTarget As Worksheet: Set ShTarget = ActiveSheet
‘This is the Report Worksheet as explained in text
Dim cell As Variant
Dim k As Single
 
Dim WsSource As Worksheet: Set WsSource = Sheets("Prod Planner")
‘This is the Source Worksheet which is called Prod Planner
Dim i, j As Integer
 
LookupRow = "4"
'Defines the LookupRow which is Row 4 in the Prod Planner worksheet, this row has all the dates entered
StartDate_Value = ShTarget.Range("D3").Value 
'The first date to be matched is in cell D3 in the Report worksheet, I’m not sure if this will work if it is in formula, although the output of the formula is in YYYY/MM/DD formate
EndDate_Value = ShTarget.Range("J3").Value 
'This is simply 1 week’s worth of dates.
 
'Not sure if the code below is confused, think it might be, should be selecting the 7 day array of data in the Source sheet
For i = 1 To 100
'Because there is approximately 100 rows in the Source table
    If WsSource.Range(LookupRow & i).Value = EndDate_Value Then EndDate_Column = i
Next i
 
For j = EndDate_Row To 1 Step -1
'I actually don’t know what this is doing exactly)
    If WsSource.Range(LookupRow & j).Value = StartDate_Value Then StartDate_Column = j
Next j
 
Dim MyDateRange As Range: Set MyDateRange = WsSource.Range(StartDate_Column & LookupRow & ":" & EndDate_Column & LookupColumn)
'Defines the array as ‘MyDateRange’
 
<code>Set</code> MyDateRange<code> = Range.SpecialCells(xlCellTypeComments)</code>
'Attempting to only return comments for cells in the selected array with comments against them. These are then put in the table as below’
<code>ShTarget.Range(</code><code>"L2") =</code> <code>"Date"</code>
'The Date is as per the date in the header of the cell, ie Row 4 of the Source worksheet
<code>ShTarget.Range("M2") =</code> <code>"Name"</code>
'The name is in the same row as the identified cell in the worksheet, in column B
<code>ShTarget.Range("N2") =</code> <code>"Cell Value"</code>
'Whatever text is in the cell
<code>ShTarge.Range("O2") =</code> <code>"Comment"</code>
<code>k=3</code>
<code>For Each cell In Rng</code>
'The below might be confused, I know I am. Basically attempting to put the data in the table as described above from the respective source. Was not sure how to do with for the Date and Name.
<code>      Ws.Range(“L” & k)=cell.Value(“</code>
<code>      Ws.Range(“M” & k)=cell.Value(“B” & i)</code>
<code>      Ws.Range(“N” & k)=cell.Value</code>
<code>      Ws.Range(“O” & k)=cell.Comment.Text</code>
<code>      k = k + 1</code>
<code>Next cell</code>
<code>End Sub</code>
​

 

[baitmaster]

The following code is probably more like what you want. There were quite a few syntax errors, undeclared variables, and confused use of ranges, but I think I've put together something like what you're trying to do. Code is untested

Option Explicit

Sub showcomments()

' create worksheet objects
Dim WsSource As Worksheet: Set WsSource = Sheets("Prod Planner")
Dim ShTarget As Worksheet: Set ShTarget = ActiveSheet

' identify locations on worksheet
Const rowHeaders As Integer = 4 ' headers are on row 4. So data starts on row 5
Const rowEnd As Integer = 100 ' arbitrary value as unsure what to use - you haven't declared anything
Const targetHeaders As Integer = 2
Dim colStartDate As Integer, colEndDate As Integer

' find dates
Dim i As Integer
For i = 1 To 100 ' loop through up to 100 header cells
    Select Case WsSource.Cells(rowHeaders, i).Value
        Case ShTarget.Range("D3").Value: colStartDate = I
        Case ShTarget.Range("J3").Value: colEndDate = I
    End Select
Next I

' check locations found
If colStartDate = 0 Or colEndDate = 0 Then
    MsgBox "ERROR: unable to locate key locations", vbCritical
    Exit Sub
End If

' apply column headers
With ShTarget
    .Range("L2") = "Date"
    .Range("M2") = "Name"
    .Range("N2") = "cl Value"
    .Range("O2") = "Comment"
    
    ' create main data range, based on header row + 1 down to rowEnd, and colStartDate across to colEndDate
    Dim rngMyData As Range: Set rngMyData = Range(WsSource.Cells(rowHeaders + 1, colStartDate), WsSource.Cells(rowEnd, colEndDate))
    
    ' loop through data and extract to new data table
    Dim cl As Range, intOutputCount As Integer
    For Each cl In rngMyData.SpecialCells(xlCellTypeComments)
        intOutputCount = intOutputCount + 1
        .Range("L" & intOutputCount + targetHeaders) = .Cells(rowHeaders, cl.Column)
        .Range("M" & intOutputCount + targetHeaders) = .Cells(cl.row, 1) ' CHECK THIS as I don't know what "name" is
        .Range("N" & intOutputCount + targetHeaders) = cl.Value
        .Range("O" & intOutputCount + targetHeaders) = cl.Comment.Text
    Next cl
End With
End Sub