Delete Periods From String

I am having trouble writing a Macro to delete multiple periods at the end of each cell. Each cell looks simiar to this: Blah Blah Blah................... I am using the InStr function to find the first period but it returns a 0 everytime. Here is the code I used to find the period. I want it to delete everything after the first period and store the value back in the same cell. Right now it just stores blanks.

Sub PeriodRemover()
Dim NewContract As String, Contract As String
Application.Calculation = xlManual
i = 2
Sheets("Product Listing by Contract").Select
Contract = Range("A" & i).Value
Do Until Contract = Empty
NewContract = Left(Contract, InStr(Contract, "."))
Range("A" & i).Value = NewContract
i = i + 1
Contract = Range("A" & i).Value
Loop
Application.Calculation = xlAutomatic
End Sub