Getting the right query row for Excel Comments

[Thompyt]

I am trying to cycle through the query rows to get data to add comments to a cell in a range. The below allows me to get comments to the right place but does not cycle through and repeats the same info on all the other cells as in cell 1



I am using QryRom to get the main info and QryProjCosts for the comment info. The string for comment info is CMNT.

Public Sub ExportQryToExcel_Click()
Dim RU As DAO.Recordset
Dim RA As DAO.Recordset2
Dim xlApp As Excel.Application
Dim WkBkA As Excel.Workbook
Dim WKSht As Excel.Worksheet
Dim TODA As String, Title As String, CMNT As String
Dim i As Integer, RCnt As Integer, RACnt As Integer, RCnt1 As Integer, RACnt1 As Integer
Dim Rng As Range, Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range, Rng5 As Range, Rng6 As Range, Rng7 As Range
 
    i = 0
    RCnt = 0
    RCnt1 = 0
 
Set RU = CurrentDb.OpenRecordset("SELECT QryROM.* From QryROM WHERE  QryROM.Titels = """ & [Forms]![FrmRom]![Titlez] & """")                                    
 
Set RA = CurrentDb.OpenRecordset("SELECT QryProjCosts.* FROM QryProjCosts INNER JOIN QryROM ON QryProjCosts.CON_ID = QryROM.CON_ID WHERE QryProjCosts.Titels = """ & [Forms]![FrmRom]![Titlez] & """")
    
    RU.MoveLast
    RU.MoveFirst
    RA.MoveLast
    RA.MoveFirst
   
    For RCnt = 1 To RU.RecordCount - 1
         Next
    RCnt1 = RCnt + 13
 
    For RACnt = 1 To RA.RecordCount - 1
         Next
     RACnt1 = RACnt + 13
           
    Title = Replace([Forms]![FrmRom]![Titlez], " ", "_")
    TODA = DLookup("[TODA]", "[QryROM]")
 
    Set xlApp = New Excel.Application
      xlApp.Visible = True
       
    Set WkBkA = xlApp.Workbooks.Add
    Set WKSht = WkBkA.Sheets(1)
       
    WkBkA.Sheets(1).Name = "ROM_" & TODA
    WkBkA.Sheets("ROM_" & TODA).Activate
   
    WkBkA.Sheets(1).Cells.Font.Name = "Calibri"
    WkBkA.Sheets(1).Cells.Font.Size = 11
               
' Columns format width
    With WkBkA.Sheets(1)
        .Columns("A:B").ColumnWidth = 20
        .Columns("C:G").ColumnWidth = 9
        .Columns("H:H").ColumnWidth = 2
        .Columns("I:O").ColumnWidth = 9
        .Columns("P:P").ColumnWidth = 20
        .Columns("R:R").ColumnWidth = 20
        .Columns("Q:Q").ColumnWidth = 6
        .Columns("S:S").ColumnWidth = 10
        .Columns("T:T").ColumnWidth = 10
        .Columns("U:U").ColumnWidth = 2
        .Columns("V:V").ColumnWidth = 10
        .Columns("W:W").ColumnWidth = 2
        .Columns("X:X").ColumnWidth = 10
        .Columns("Y:Y").ColumnWidth = 36
        .Columns("Z:Z").ColumnWidth = 10
    End With
   
' Rows 1 through 9 words & Format
    WKSht.Range("A1:A4,B2:E2,A11:A12,B11:B12,C11:E11,F11:F12,G11:G12,I11:I12,J11:J12,K11:K12,L11:L12,M11:M12,N11:N12,O11:O12,P11:P12,Q11:Q12,R11:R12,S11:S12,T11:T12,V11:V12,X11:X12,Y11:Y12,Z11:Z12,A10:G10,I10:T10,X10:Z10").Merge
 
    WKSht.Range("A1:A4") = [Forms]![FrmRom]![Titlez]
    WKSht.Range("A1:A4").Font.FontStyle = "Bold"
    WKSht.Range("A1:A4").WrapText = True
 
    WKSht.Range("A9") = "Fielding Support"
    WKSht.Range("A9").Font.FontStyle = "Bold"
 
    WKSht.Range("B2:E2") = "Overall ROM"
    With WKSht.Range("B2:E2")
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThin
        .Font.FontStyle = "Bold"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
 
    WKSht.Range("B3") = "Travel"
    WKSht.Range("B4") = "EWW Labor3"
    With WKSht.Range("B4")
        .Characters(Start:=1, Length:=9).Font.FontStyle = "Bold"
        .Characters(Start:=10, Length:=1).Font.FontStyle = "Bold"
        .Characters(Start:=10, Length:=1).Font.Superscript = True
    End With
 
    WKSht.Range("B5") = "Materials"
    WKSht.Range("B6") = "Shipping"
    WKSht.Range("B7") = "Total"
 
    WKSht.Range("B3:B7,D7").HorizontalAlignment = xlRight
    WKSht.Range("B3:B7,D7").Font.FontStyle = "Bold"
 
    WKSht.Range("D6").Borders(xlEdgeBottom).LineStyle = xlDouble
    WKSht.Range("D6").Borders(xlEdgeBottom).Weight = xlThick
    WKSht.Range("D3:D6").HorizontalAlignment = xlRight
 
' Row 10 Fill Color Pale Green, Format and Row Titles
    WKSht.Range("I10:T10") = "EWW"
    WKSht.Range("V10") = "Travel"
    WKSht.Range("X10:Z10") = "ODCs"
 
    WKSht.Range("A10:G10") = "Support Peronnel1"
    WKSht.Range("A10:G10").Characters(Start:=1, Length:=16).Font.FontStyle = "Bold"
    WKSht.Range("A10:G10").Characters(Start:=17, Length:=1).Font.Superscript = True
 
    With WKSht.Range("A10:G10,I10:T10,V10,X10:Z10")
        .HorizontalAlignment = xlCenter
        .Interior.ThemeColor = xlThemeColorAccent6
        .Interior.TintAndShade = 0.399975585192419
    End With
   
    WKSht.Range("I10:T10,V10,X10:Z10").Font.FontStyle = "Bold"
 
    With WKSht.Range("A9,A10:G12,I10:T12,V10:V12,X10:Z12")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders.Weight = xlThin
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
    End With
 
' Rows 11 & 12 Format
    WKSht.Range("A11") = "Position - Title"
    WKSht.Range("B11") = "TimeFrame(s)"
 
    WKSht.Range("C11:E11") = "Regular Weekdays"
    WKSht.Range("C11:E11").Font.FontStyle = "Bold"
 
    WKSht.Range("C12") = "Travel Days"
    WKSht.Range("D12") = "On-site Days"
    WKSht.Range("E12") = "Total"
    WKSht.Range("F11") = "Hours / Day"
   
    WKSht.Range("G11") = "Total Regular Hours1"
    WKSht.Range("G11").Characters(Start:=1, Length:=19).Font.FontStyle = "Regular"
    WKSht.Range("G11").Characters(Start:=20, Length:=1).Font.Superscript = True
 
    WKSht.Range("I11") = "Week Days"
   
    WKSht.Range("J11") = "Extended Hour/Day6"
    WKSht.Range("J11").Characters(Start:=1, Length:=17).Font.FontStyle = "Regular"
    WKSht.Range("J11").Characters(Start:=18, Length:=1).Font.Superscript = True
 
    WKSht.Range("K11") = "Total Extended Week Day Hours"
 
    WKSht.Range("L11") = "Weekend & Holidays Days6"
    WKSht.Range("L11").Characters(Start:=1, Length:=23).Font.FontStyle = "Regular"
    WKSht.Range("L11").Characters(Start:=24, Length:=1).Font.Superscript = True
 
    WKSht.Range("M11") = "Weekend Hours/Day"
    WKSht.Range("N11") = "Weekend Hours"
 
    WKSht.Range("O11") = "Total EWW Hours3"
    WKSht.Range("O11").Characters(Start:=1, Length:=15).Font.FontStyle = "Regular"
    WKSht.Range("O11").Characters(Start:=16, Length:=1).Font.Superscript = True
 
    WKSht.Range("P11") = "LCAT"
    WKSht.Range("Q11") = "SCA"
    WKSht.Range("R11") = "Personnel"
 
    WKSht.Range("S11") = "Average OT Rate2"
    WKSht.Range("S11").Characters(Start:=1, Length:=15).Font.FontStyle = "Regular"
    WKSht.Range("S11").Characters(Start:=16, Length:=1).Font.Superscript = True
 
    WKSht.Range("T11") = "EWW Cost"
 
    WKSht.Range("V11") = "Projected4 Travel Cost"
    With WKSht.Range("V11")
        .Characters(Start:=1, Length:=9).Font.FontStyle = "Regular"
        .Characters(Start:=10, Length:=1).Font.Superscript = True
        .Characters(Start:=11, Length:=12).Font.Superscript = False
    End With
 
    WKSht.Range("X11") = "Type5"
    WKSht.Range("X11").Characters(Start:=1, Length:=4).Font.FontStyle = "Regular"
    WKSht.Range("X11").Characters(Start:=5, Length:=1).Font.Superscript = True
 
    WKSht.Range("Y11") = "Description"
    WKSht.Range("Z11") = "Projected Cost"
    WKSht.Rows("12:12").EntireRow.AutoFit
 
    For i = 1 To RU.Fields.Count - 2
        WkBkA.Sheets(1).Cells(13, i).Value = RU.Fields(i)
        WkBkA.Sheets(1).Cells(13, i).Value = RA.Fields(i)
    Next
        WkBkA.Sheets(1).Range("A13").CopyFromRecordset RU
        
    CMNT = Date & Chr(13) & Chr(10) & "Name: " & RA.[Names] & Chr(13) & Chr(10) & "Airfare: " & Format(RA.[Airfare], "Currency") & Chr(13) & Chr(10) & "Booking Agency Fee:  $25" & Chr(13) & Chr(10) & "Hotel: " & Format(RA.[PDLodge], "Currency") & " /Night X " & RA.[TDLDay] & " = " & _
    Format(RA.[LodgeTTL], "Currency") & Chr(13) & Chr(10) & "Hotel Tax: " & Format(RA.[LodgeTTL], "Currency") & " X  15% = " & Format(RA.[LodgeTax], "Currency") & Chr(13) & Chr(10) & "Rental Car: " & Format(RA.[Rent_Cost], "Currency") & _
    " X " & RA.[RentDays] & " = " & Format(RA.[RentTTL], "Currency") & "(" & RA.[Rent_Type] & ")" & Chr(13) & Chr(10) & "Rental Tax: " & Format(RA.[RentTTL], "Currency") & " X  15% = " & _
    Format(RA.[RentTaxTTL], "Currency") & Chr(13) & Chr(10) & "Gas: " & Format(RA.[Gas], "Currency") & " X " & RA.[RentDays] & " =  " & Format(RA.[Fuel], "Currency") & Chr(13) & Chr(10) & "Rental Parking/Tolls : " & _
    Format(RA.[Tolls], "Currency") & Chr(13) & Chr(10) & "Checked Baggage Fee: " & RA.[Bag] & " X " & RA.[NumBag] & " = " & Format(RA.[BagCost], "Currency") & " (" & RA.[Carrier] & ")" & Chr(13) & Chr(10) & "Excess Baggage (tools): " & _
    Format(RA.[ExcsBagCost], "Currency") & Chr(13) & Chr(10) & "M&IE: " & RA.[TDYDay] - 2 & " X " & Format(RA.[PDMeal], "Currency") & " = " & Format(RA.[PDNorm], "Currency") & "; (3/4) 2 X " & Format(RA.[PDMeal], "Currency") * 0.75 & " = " & _
    Format((RA.[PDMeal] * 0.75) * 2, "Currency") & " = " & Format(RA.[MealTTL], "Currency") & Chr(13) & Chr(10) & "Airport Parking: $7 X " & RA.[TDYDay] & " = " & Format(RA.[AirPark], "Currency") & Chr(13) & Chr(10) & "Total: " & Format(RA.[LegTTL], "Currency")
  
    Set Rng1 = WKSht.Range("V1:V" & RCnt1)
    Set Rng2 = WKSht.Range("T1:T" & RCnt1)
    Set Rng3 = WKSht.Range("V1:V" & RCnt1)
    Set Rng4 = WKSht.Range("Z1:Z" & RCnt1)
    Set Rng5 = WKSht.Range("D3:D6")
    Set Rng6 = WKSht.Range("AA1:AA" & RCnt1)
    Set Rng7 = WKSht.Range("AB1:AB" & RCnt1)
 
    WKSht.Range("T" & RCnt1).Value = WorksheetFunction.Sum(Rng2)
    WKSht.Range("V" & RCnt1).Value = WorksheetFunction.Sum(Rng3)
    WKSht.Range("Z" & RCnt1).Value = WorksheetFunction.Sum(Rng4)
    WKSht.Range("AA" & RCnt1).Value = WorksheetFunction.Sum(Rng6)
    WKSht.Range("AB" & RCnt1).Value = WorksheetFunction.Sum(Rng7)
 
    WKSht.Range("D3").Value = WKSht.Range("V" & RCnt1).Value
    WKSht.Range("D4").Value = WKSht.Range("T" & RCnt1).Value
    WKSht.Range("D5").Value = WKSht.Range("AA" & RCnt1).Value
    WKSht.Range("D6").Value = WKSht.Range("AB" & RCnt1).Value
    WKSht.Range("D7").Value = WorksheetFunction.Sum(Rng5)
   
       
      '  .Shape.Width = 15
      '  .Shape.Height = 15
  '      .Comment.Text Text:=CMNT
 '   End With
       
    For RACnt1 = 13 To RA.RecordCount + 12
        WKSht.Range("V" & RACnt1).AddComment CMNT
            Debug.Print "V" & RACnt1, vbCrLf & CMNT
    Next
                       
    With WKSht.Range("A11:Z" & RCnt1)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Font.FontStyle = "Regular"
    End With
   
    WKSht.Range("A13:A" & RCnt1).HorizontalAlignment = xlLeft
    WKSht.Range("P13:P" & RCnt1).HorizontalAlignment = xlLeft
    WKSht.Range("R13:R" & RCnt1).HorizontalAlignment = xlLeft
    WKSht.Range("Y13:Y" & RCnt1).HorizontalAlignment = xlLeft
 
 
    On Error Resume Next
    WkBkA.SaveAs ("C:\Temp\" & Title & ".xlsx"), AccessMode:=xlExclusive, ConflictResolution:=xlLocalSessionChanges
 
    xlApp.DisplayAlerts = True
    xlApp.CutCopyMode = False
    'xlApp.Quit
   
    Set WKSht = Nothing
    Set WkBkA = Nothing
    Set xlApp = Nothing
    Set RU = Nothing
    i = 0
    RCnt = 0
    RCnt1 = 0
 
Exit Sub

[Bulzie]

Where is your loop, are you adding 1 to the count or using a Move Next before looping back to the top? Might want to put a breakpoint at the top and Step thru the code using F8 to see where it is going.

[Thompyt]

This gets me the Comment in the right spot

    RA.MoveLast    RA.MoveFirst
    For RACnt1 = 13 To RA.RecordCount + 12
            WKSht.Range("V" & RACnt1).AddComment CMNT
            Debug.Print "V" & RACnt1, vbCrLf & CMNT
    Next

This gets me a 1004 on WKSht.Range("V" & RACnt1).AddComment CMNT

    For RACnt1 = 13 To RA.RecordCount + 12        Do While Not RA.EOF
            WKSht.Range("V" & RACnt1).AddComment CMNT
            Debug.Print "V" & RACnt1, vbCrLf & CMNT
        RA.MoveNext
        Loop
    Next

This gets me a 1004 on WKSht.Range("V" & RACnt1).AddComment CMNT but in the right spot with row 1 data in query QryProjCosts

    Do While Not RA.EOF
        For RACnt1 = 1 To RA.RecordCount
            WKSht.Range("V" & RACnt1 + 12).AddComment CMNT
            Debug.Print "V" & RACnt1, vbCrLf & CMNT
        Next
    RA.MoveNext
    Loop

[Welshgasman]

Why do you bother walking the recordsets?
You do not appear to use anything from them?

The key to this is where you set CMNT, so that it uses different data on each pass.

[Micron]

This gets me a 1004 on WKSht.Range("V" & RACnt1).AddComment CMNT

If you already have a comment you must delete it before you can insert one. Mabybe test first, like

     If Not rnge.Comment Is Nothing Then
        rnge.ClearComments
        rnge.AddComment "test"

Please don't expect helpers to look up error number descriptions. In this case, 1004 must have about 20 different meanings so even if I knew what message you were getting (and I probably do) this number is really of zero help.

[Thompyt]

Micron, I understand your Runtime error references. Will state explicit. your rnge as I take it is a Range. I Am unsure as to how you reference the data in that rnge.

with numbers its:

Set Rng = WKSht.Range("V1:V" & RCnt1)
WKSht.Range("V" & RCnt1).Value = WorksheetFunction.Sum(Rng)

But I am trying to put the CMNT string into the comments that are for each row. I have looked at the rows/records in the

Set RA = CurrentDb.OpenRecordset("SELECT QryProjCosts.* FROM QryProjCosts INNER JOIN QryROM ON QryProjCosts.CON_ID = QryROM.CON_ID WHERE QryProjCosts.Titels = """ & [Forms]![FrmRom]![Titlez] & """")

and it works out to the correct number of records.

I simplified the Code and run into the same issue:

Sub GetRowDataFromQuery_Click()
Dim db As DAO.Database
Dim RA As DAO.Recordset2
Dim xlApp As Excel.Application
Dim WkBkA As Excel.Workbook
Dim WKSht As Excel.Worksheet
Dim i As Integer, RowCnt As Integer
Dim CMNT As String, strSQL As String
Dim Rng As Range
    
    i = 0
    RowCnt = 0
    
    Set xlApp = New Excel.Application
      xlApp.Visible = True
        
    Set WkBkA = xlApp.Workbooks.Add
    Set WKSht = WkBkA.Sheets(1)
    WkBkA.Sheets(1).Activate
    
        With WkBkA.Sheets(1)
            .Columns("A:A").ColumnWidth = 20
        End With
    
    Set db = CurrentDb
    strSQL = ("SELECT [Names] FROM QryProjCosts WHERE QryProjCosts.Titels = """ & [Forms]![FrmRom]![Titlez] & """")   ' Defines recordset2


    ' Open the recordset
    Set RA = db.OpenRecordset(strSQL)
    
    CMNT = Date & " " & RA.Names
    
    For i = 0 To RA.RecordCount - 1
        Next


 '  If Not Rng.Comment Is Nothing Then
 '       Rng.ClearComments
 '           Rng.AddComment "test"
 '   End If


    RA.MoveLast
    RA.MoveFirst
     
    ' Loop through the recordset
    Do While Not RA.EOF
        i = i + 1
        ' Access data in the current row
        WkBkA.Sheets(1).Range("A" & i).AddComment CMNT
            Debug.Print "V" & i & " " & CMNT
        ' Move to the next row
        RA.MoveNext
    Loop

' close recordset
    RA.Close
    Set RA = Nothing
    Set db = Nothing
    i = 0
    RowCount = 0
End Sub

With the above I get the first row data each time. Not new data for each row.

What do you mean Welsh? I am trying to cycle through the recordset and having the comments be populated.

[Thompyt]

Fixed:

   Do While Not RA.EOF        Set Rng = WKSht.Cells(j + 12, 22)
        If Not Rng.Comment Is Nothing Then
             Rng.Comment.Delete
        End If
            Rng.AddComment Text:=Date & vbCrLf & "Airfare: " & Format(RA.[Airfare], "Currency") & vbCrLf & "Booking Agency Fee:  $25" & vbCrLf & "Hotel: " & Format(RA.[PDLodge], "Currency") & " /Night X " & RA.[TDLDay] & " = " & _
            Format(RA.[LodgeTTL], "Currency") & vbCrLf & "Hotel Tax: " & Format(RA.[LodgeTTL], "Currency") & " X  15% = " & Format(RA.[LodgeTax], "Currency") & vbCrLf & "Rental Car: " & Format(RA.[Rent_Cost], "Currency") & _
            " X " & RA.[RentDays] & " = " & Format(RA.[RentTTL], "Currency") & "(" & RA.[Rent_Type] & ")" & vbCrLf & "Rental Tax: " & Format(RA.[RentTTL], "Currency") & " X  15% = " & _
            Format(RA.[RentTaxTTL], "Currency") & vbCrLf & "Gas: " & Format(RA.[Gas], "Currency") & " X " & RA.[RentDays] & " =  " & Format(RA.[Fuel], "Currency") & vbCrLf & "Rental Parking/Tolls : " & _
            Format(RA.[Tolls], "Currency") & vbCrLf & "Checked Baggage Fee: " & RA.[Bag] & " X " & RA.[NumBag] & " = " & Format(RA.[BagCost], "Currency") & " (" & RA.[Carrier] & ")" & vbCrLf & "Excess Baggage (tools): " & _
            Format(RA.[ExcsBagCost], "Currency") & vbCrLf & "M&IE: " & RA.[TDYDay] - 2 & " X " & Format(RA.[PDMeal], "Currency") & " = " & Format(RA.[PDNorm], "Currency") & "; (3/4) 2 X " & Format(RA.[PDMeal], "Currency") * 0.75 & " = " & _
            Format((RA.[PDMeal] * 0.75) * 2, "Currency") & " = " & Format(RA.[MealTTL], "Currency") & vbCrLf & "Airport Parking: $7 X " & RA.[TDYDay] & " = " & Format(RA.[AirPark], "Currency") & vbCrLf & "Total: " & Format(RA.[LegTTL], "Currency")
        RA.MoveNext
        j = j + 1
    Loop

[Micron]

Yes, rnge is a range variable in my code. I'm trying to help with the add comment issue but here's the problem for me:
- I told you if there is a comment in a range and you try to use the AddComment method you will raise error 1004. I suggested you test for a comment as you loop through your cells and if one is there, you'll have to remove it to add one. I gave you code for that but it seems that you just stuck it in anywhere and commented that part out. If you didn't have it commented out and tried it where it is, then that is not clear but where I see it now, it will do no good whatsoever. You must test before you try to add, which is being done inside your loop. So more like

If WkBkA.Sheets(1).Range("A" & i).Comment Is Not Nothing Then WkBkA.Sheets(1).Range("A" & i).ClearComments

Now add a comment if that is what is required. I see a range variable is declared but I don't see where you're using it.