Preserving Excel Comments Across versions

You may need to save comment from one excel model and load them into another file. This can be a time consuming task and this routine will eliminate if ( big IF) you have a key column to store the comments on

Sub SaveComments()
Dim rst As Recordset, i As Integer, tmpComment, tmpCrystal
Dim db As Database
Set db = OpenDatabase("Your Access Database")
 
If MsgBox("Save these comments to the database ?", vbYesNo) = vbNo Then
    Exit Function
End If
 
Range("D1").Select
 
For i = 2 To 5000
    ActiveCell.Offset(1, 0).Select
    tmpCrystal = ActiveCell.Value
    tmpComment = ActiveCell.Offset(0, 62).Value
    If Len(tmpComment & "") > 0 Then
        If Len(tmpCrystal & "") > 0 Then
            Set rst = db.OpenRecordset("select * from tblComments where CrystalID='" & tmpCrystal & "'")
            If rst.RecordCount > 0 Then
                rst.MoveFirst
                rst.Edit
            Else
                rst.AddNew
            End If
            rst!CrystalID = tmpCrystal
            rst!Comments = tmpComment
            rst.Update
        End If
    End If
Next i
 
Set rst = Nothing
MsgBox "Comments Updated"
 
End Sub

And now the function to load the comments

Sub LoadComments()
Dim rst As Recordset, i As Integer, tmpComment, tmpCrystal
Dim db As Database
Set db = OpenDatabase("Your Access Database")
 
If MsgBox("LOAD Comments into this File from the Database ", vbYesNo) = vbNo Then
    Exit Function
End If
 
tmpComment = ""
Range("BN2").Select
For i = 2 To 5000
    tmpComment = tmpComment & ActiveCell.Value
    ActiveCell.Offset(1, 0).Select
Next
 
If Len(tmpComment & "") > 1 Then
    If MsgBox("Comments already exist these may be lost - CONTINUE ?", vbYesNo) = vbNo Then
        Exit Function
    End If
End If
 
Range("D1").Select
 
For i = 2 To 5000
    ActiveCell.Offset(1, 0).Select
    tmpCrystal = ActiveCell.Value
    '
    If Len(tmpCrystal & "") > 2 Then
        Set rst = db.OpenRecordset("select * from tblComments where CrystalID='" & tmpCrystal & "'")
        If rst.RecordCount > 0 Then
            rst.MoveFirst
            ActiveCell.Offset(0, 62).Value = rst!Comments
        End If
    End If
Next i
 
Set rst = Nothing
MsgBox "Comments Updated"
 
End sub