Leave only letters in range of cells vba

[ThomasOES]

Hello

How to leave only letters (element symbols) in a range of cells. The range begins at E1. Each element (Ex. Al240 %) is one cell.

Make this:

[TABLE="width: 1536"]
<tbody>[TR]
[TD="width: 64, bgcolor: transparent"]Al240%[/TD]
[TD="width: 64, bgcolor: transparent"]As189%[/TD]
[TD="width: 64, bgcolor: transparent"]B208%[/TD]
[TD="width: 64, bgcolor: transparent"]C165%[/TD]
[TD="width: 64, bgcolor: transparent"]Ca393%[/TD]
[TD="width: 64, bgcolor: transparent"]Co340%[/TD]
[TD="width: 64, bgcolor: transparent"]Cr267%[/TD]
[TD="width: 64, bgcolor: transparent"]Cu327%[/TD]
[TD="width: 64, bgcolor: transparent"]Fe249%[/TD]
[TD="width: 64, bgcolor: transparent"]Mn_Calc.[/TD]
[TD="width: 64, bgcolor: transparent"]Mo386%[/TD]
[TD="width: 64, bgcolor: transparent"]Nb400%[/TD]
[TD="width: 64, bgcolor: transparent"]Ni341%[/TD]
[TD="width: 64, bgcolor: transparent"]P177%[/TD]
[TD="width: 64, bgcolor: transparent"]Pb220%[/TD]
[TD="width: 64, bgcolor: transparent"]S180%[/TD]
[TD="width: 64, bgcolor: transparent"]Sb206%[/TD]
[TD="width: 64, bgcolor: transparent"]Si_Calc.[/TD]
[TD="width: 64, bgcolor: transparent"]Sn326%[/TD]
[TD="width: 64, bgcolor: transparent"]Ta362%[/TD]
[TD="width: 64, bgcolor: transparent"]Ti337%[/TD]
[TD="width: 64, bgcolor: transparent"]V411%[/TD]
[TD="width: 64, bgcolor: transparent"]W400%[/TD]
[TD="width: 64, bgcolor: transparent"]Zr360%[/TD]
[/TR]
</tbody>[/TABLE]


Look like this:

[TABLE="width: 1920"]
<tbody>[TR]
[TD="width: 64, bgcolor: transparent"]Al[/TD]
[TD="width: 64, bgcolor: transparent"]As[/TD]
[TD="width: 64, bgcolor: transparent"]B[/TD]
[TD="width: 64, bgcolor: transparent"]Be[/TD]
[TD="width: 64, bgcolor: transparent"]C[/TD]
[TD="width: 64, bgcolor: transparent"]Ca[/TD]
[TD="width: 64, bgcolor: transparent"]Co[/TD]
[TD="width: 64, bgcolor: transparent"]Cr[/TD]
[TD="width: 64, bgcolor: transparent"]Cu[/TD]
[TD="width: 64, bgcolor: transparent"]Fe[/TD]
[TD="width: 64, bgcolor: transparent"]La[/TD]
[TD="width: 64, bgcolor: transparent"]Mg[/TD]
[TD="width: 64, bgcolor: transparent"]Mn[/TD]
[TD="width: 64, bgcolor: transparent"]Mo[/TD]
[TD="width: 64, bgcolor: transparent"]N![/TD]
[TD="width: 64, bgcolor: transparent"]Nb[/TD]
[TD="width: 64, bgcolor: transparent"]Ni[/TD]
[TD="width: 64, bgcolor: transparent"]P[/TD]
[TD="width: 64, bgcolor: transparent"]Pb[/TD]
[TD="width: 64, bgcolor: transparent"]S[/TD]
[TD="width: 64, bgcolor: transparent"]Sb[/TD]
[TD="width: 64, bgcolor: transparent"]Si[/TD]
[TD="width: 64, bgcolor: transparent"]Sn[/TD]
[TD="width: 64, bgcolor: transparent"]Ta[/TD]
[TD="width: 64, bgcolor: transparent"]Ti[/TD]
[TD="width: 64, bgcolor: transparent"]V[/TD]
[TD="width: 64, bgcolor: transparent"]W[/TD]
[TD="width: 64, bgcolor: transparent"]Zn[/TD]
[TD="width: 64, bgcolor: transparent"]Zr
[/TD]
[TD="width: 64, bgcolor: transparent"][/TD]
[/TR]
</tbody>[/TABLE]

Also remove any spaces and the phrase "Calc".

Thanks for any help

Tom

 

[ThomasOES]

Please disregard the N! in the second line

 

[Special-K99]

Prob a better way but this seems to work

Sub k1()
lastcol = Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 5 To lastcol
Cells(2, i) = Left(Cells(1, i), 2)
Next
End Sub

 

[Fluff]

Another option

Sub GetElements()
   With Range("E1", Cells(1, Columns.Count).End(xlToLeft))
      .Value = Evaluate(Replace("if(isnumber(mid(@,2,1)*1),left(@,1),left(@,2))", "@", .Address))
   End With
End Sub

 

[ThomasOES]

I tried this and it works great to remove the phrase and %. How to .Replace What:=numbers, Replacement:=""

Range("E1", Selection.End(xlToRight)).Select
For Each cell In Selection
With cell
    .Replace What:="_Calc.", Replacement:=""
    .Replace What:=" %", Replacement:=""
End With
Next

Tom

 

[ThomasOES]

Thanks MVP. Perfect

Tom

 

[Fluff]

Glad we could help & thanks for the feedback