Cycle through datasets, columns and then rows to add comments based on other cells - vba

Question

I'm trying to make a function to do the following:
Cycle through all my datasets in my sheet
Cycle through each column in my datasets
Look at the title for that column and check if it is in my list.
Find find a few various other columns, but this time using .Find
Now cycle through each row in the column for that specific dataset
Use the column references found in point 4 and the row from point 5 to put the cell's into a variable that will be used on step 7 which is to insert a formatted comment in the originally found column (for that row).
I've tried getting some code working from what I found on a different site but I can't get it working correct, I'm stuck at part 5.
A data example could look like:
My attempted code looks like:
Sub ComTest()
COMLIST = ";Cond;"
Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each a In rng.SpecialCells(xlCellTypeConstants).Areas
With a.CurrentRegion
Set r = .Rows(1)
For j = 1 To r.Columns.Count
TitleCell = r.Cells(j).Address
v = ";" & Range(TitleCell).Value & ";"
'-----------------------------------------------------------------------------------------
If InStr(1, COMLIST, v) Then
On Error Resume Next
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Condw = r.Columns.Find(Replace(v, ";", "") & " " & "w", lookAt:=xlWhole).Column
Condw = .Cells(r, Condw).Address
' Add more stuff here
End If
'-----------------------------------------------------------------------------------------
Next j
End With
Next a
End Sub
As for part 7, the output would essentially be as follows for "row 1" but this part I should be able to do, it's the looping part that I am struggling with.

Answer 1

This question raises a few points that this answer might resolve for you and others in the future:
I note that not many of your previous questions have accepted answers, and that several of them present answers but you have needed to respond by saying it doesn't suit your needs for a certain reason. It suggests you aren't really providing the right details in your question. I think that's the case here. Perhaps you could outline the outcome you are trying to achieve and, especially for Excel VBA, the precise structure of your spreadsheet data. It's tempting to think in this question that you simply want to know how to take the values of Columns C to F and write them to a comment in Column B for any row that contains data.
Using web code can often take more time to understand and adapt than learning the code syntax from first principles. Your provided code is difficult to follow and some parts seem odd. I wonder, for example, what this snippet is meant to do:
xRange = .Offset(1).Resize(.Rows.Count - 1).Columns(j).Address
For i = 1 To UBound(xRange)
v = b.Value
Next i
Using Option Explicit at the top of your module (which forces you to declare your variables) makes VBA coding and debugging much easier, and code submitted on SO is easier to follow if we can see what data types you meant variables to hold.
If your question is merely "How do I take the values of Columns C to F and write them to the cell in Column B for any row that contains data?", then your code could be as simple as:
Dim condCol As Range
Dim cell As Range
Dim line1 As String
Dim line2 As String
Dim cmt As Comment
'Define the "Cond" column range
'Note: this is an unreliable method but we'll use it here for the sake of brevity
Set condCol = ThisWorkbook.Worksheets("Sheet1").UsedRange.Columns("B")
'Delete any comment boxes
condCol.ClearComments
'Loop through the cells in the column and process the data if it's a number
For Each cell In condCol.Rows
If Not IsEmpty(cell.Value) And IsNumeric(cell.Value) Then
'Acquire the comment data
line1 = "Cond: " & cell.Offset(, 1).Value & "/" & cell.Offset(, 2).Value & _
" (" & Format(cell.Offset(, 3), "0.00%") & ")"
line2 = "Cond pl: $" & cell.Offset(, 4).Value
Set cmt = cell.AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
End If
Next
If, on the other hand, your question is that you have unreliable data on your spreadsheet and your only certainty is that the headings exist on any one row, then some form of search routine must be added. In that case your code could look like this:
Dim rng As Range
Dim rowRng As Range
Dim cell As Range
Dim condCol(0 To 4) As Long
Dim line1 As String
Dim line2 As String
Dim allHdgsFound As Boolean
Dim i As Integer
Dim cmt As Comment
Set rng = ThisWorkbook.Worksheets("Sheet1").UsedRange
rng.ClearComments
For Each rowRng In rng.Rows
If Not allHdgsFound Then
'If we haven't found the headings,
'loop through the row cells to try and find them
For Each cell In rowRng.Cells
Select Case cell.Value
Case Is = "Cond": condCol(0) = cell.Column
Case Is = "Cond w": condCol(1) = cell.Column
Case Is = "Cond r": condCol(2) = cell.Column
Case Is = "Cond %": condCol(3) = cell.Column
Case Is = "Cond wpl": condCol(4) = cell.Column
End Select
Next
'Check if we have all the headings
'by verifying the condCol array has no 0s
allHdgsFound = True
For i = 0 To 4
If condCol(i) = 0 Then
allHdgsFound = False
Exit For
End If
Next
Else
If Not IsEmpty(rowRng.Cells(1).Value) Then
'The cell has values so populate the comment strings
line1 = "Cond: " & rowRng.Columns(condCol(1)).Value & "/" & _
rowRng.Columns(condCol(2)).Value & _
" (" & Format(rowRng.Columns(condCol(3)).Value, "0.00%") & ")"
line2 = "Cond pl: $" & rowRng.Columns(condCol(4))
Set cmt = rowRng.Columns(condCol(0)).AddComment(line1 & vbCrLf & line2)
'Format the shape
With cmt.Shape.TextFrame
.Characters(1, 5).Font.Bold = True
.Characters(Len(line1 & vbCrLf), 8).Font.Bold = True
.AutoSize = True
End With
Else
'We've reached a blank cell so re-set the found values
allHdgsFound = False
Erase condCol
End If
End If
Next
Of course your data might be structured in any number of other ways, but we don't know that. My point is that if you can be more specific in your question and provide an outcome you are trying to achieve, you are likely to receive answers that are more useful to you.