Macro AA_Convert_3to1

Converts sequence alignment from 3-letter code to 1-letter-code. Before conversion, each code triplett has to be placed in a separate cell , e.g. by using the macro "AA_Parse_3Letter".

Usage:

• Select the range of cells containing the tripletts to be converted
• Choose "Macro" for the "Tool" menu
• Run macro AA_Convert_3to1

Caution:

The original sequence will be overwritten by the converted one. If you wish to keep a copy of the original sequence, duplicate the worksheet before invoking the macro. The sequence length is limited to 250 amino acids.

Sub AA_Convert_3to1()

'Converts sequence alignment from 3-letter code to 1-letter-code (for KABAT database)
'replaces input triplett by output letter => copy sheet before translating
'Color highlighting of uninterpretable data or Comment indicators

    If Selection.Columns.Count = 0 Then      'Error, nothing selected
        MsgBox Prompt:="No cells selected, please select the sequences you wish to color"
        Exit Sub
    End If

    'get extent of current selection
    i1 = Selection.Row
    i2 = i1 + Selection.Rows.Count - 1
    j1 = Selection.Column
    j2 = j1 + Selection.Columns.Count - 1
    
    For i = i1 To i2 Step 1
        For j = j1 To j2 Step 1
        
            If (VarType(Cells(i, j)) <> 8) Then
                Cells(i, j) = "?"               'Cell does not contain a text string, highlight in red
                Cells(i, j).Select
                With Selection.Interior
                    .ColorIndex = 3
                    .Pattern = xlSolid
                End With
                
                   ElseIf ((Cells(i, j) Like " ") Or (Cells(i, j) Like "  ") Or (Cells(i, j) Like "   ")) Then Cells(i, j) = ""
                    ElseIf Cells(i, j) Like "---" Then Cells(i, j) = "."
                     ElseIf Cells(i, j) Like "ALA" Then Cells(i, j) = "A"
                      ElseIf Cells(i, j) Like "ASX" Then Cells(i, j) = "B"
                       ElseIf Cells(i, j) Like "CYS" Then Cells(i, j) = "C"
                        ElseIf Cells(i, j) Like "ASP" Then Cells(i, j) = "D"
                         ElseIf Cells(i, j) Like "GLU" Then Cells(i, j) = "E"
                          ElseIf Cells(i, j) Like "PHE" Then Cells(i, j) = "F"
                           ElseIf Cells(i, j) Like "GLY" Then Cells(i, j) = "G"
                            ElseIf Cells(i, j) Like "HIS" Then Cells(i, j) = "H"
                             ElseIf Cells(i, j) Like "ILE" Then Cells(i, j) = "I"
                              ElseIf Cells(i, j) Like "LYS" Then Cells(i, j) = "K"
                               ElseIf Cells(i, j) Like "LEU" Then Cells(i, j) = "L"
                                ElseIf Cells(i, j) Like "MET" Then Cells(i, j) = "M"
                                 ElseIf Cells(i, j) Like "ASN" Then Cells(i, j) = "N"
                                  ElseIf Cells(i, j) Like "PRO" Then Cells(i, j) = "P"
                                   ElseIf Cells(i, j) Like "GLN" Then Cells(i, j) = "Q"
                                    ElseIf Cells(i, j) Like "ARG" Then Cells(i, j) = "R"
                                     ElseIf Cells(i, j) Like "SER" Then Cells(i, j) = "S"
                                      ElseIf Cells(i, j) Like "THR" Then Cells(i, j) = "T"
                                       ElseIf Cells(i, j) Like "VAL" Then Cells(i, j) = "V"
                                        ElseIf Cells(i, j) Like "TRP" Then Cells(i, j) = "W"
                                         ElseIf Cells(i, j) Like "TYR" Then Cells(i, j) = "Y"
                                          ElseIf Cells(i, j) Like "GLX" Then Cells(i, j) = "Z"
                                           ElseIf Cells(i, j) Like "PCA" Then Cells(i, j) = "E" 'N-terminal pyroglutamic acid
                                            ElseIf ((Cells(i, j) Like " # ") Or (Cells(i, j) Like "#")) Then
                                                'Cells containing comment marks in KABAT Database potentially indicating insertions
                                                'Hash mark has special significance in Excel, cannot be used, replace by "&"
                                                Cells(i, j) = "&"
                                                'Highlight Cell:
                                                Cells(i, j).Select
                                                With Selection.Interior
                                                   .ColorIndex = 4
                                                   .Pattern = xlSolid
                                                End With
                                             Else
                                              'Unidentified, highlight cell:
                                                Cells(i, j) = "?"  
                                                Cells(i, j).Select
                                                With Selection.Interior
                                                   .ColorIndex = 3
                                                   .Pattern = xlSolid
                                                End With
                End If
        Next j
    Next i
    
End Sub