VBA String Error

[sh1pley]

Hi I have been asked to look at some code that is no longer working. Unfortunately the person who wrote it is no longer contactable

The process is the user imports a text file into excel and then runs the below macro which separates the data into columns. However the long number string is coming through incorrectly

This number: 08052015924403668915
Is coming through as: 08052015924403666000

I think when the code was written the long number was a bit shorter but unfortunately I don't understand all of his code to work out where it is going wrong!

Any help would be appreciated


Sub Calc()

invoicenumber = 0
Dim output(10000, 100)
resultoutputrow = 2
Sheets("Output").Range("a3:z1000").ClearContents
Dim restnumb(100)
For t = 1 To 86
restnumb(t) = Sheets("Codes").Cells(t, 1)
Next t

Dim LastRow As Long
With Sheets("Data")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With


Dim WrdArray() As String
Dim text_string As String


For y = 3 To LastRow

resultoutputrow = resultoutputrow + 1
text_string = Sheets("Data").Cells(y, 1)
WrdArray() = Split(text_string)



Do Until WrdArray(i) = "LOGISTICS" Or WrdArray(i) = "LTD." Or WrdArray(i) = "DIRECT" Or WrdArray(i) = "Grocery" Or WrdArray(i) = "Frozen"

If WrdArray(i) <> "" Then
outputcolumn = outputcolumn + 1
output(resultoutputrow, outputcolumn) = WrdArray(i)
End If
i = i + 1

Loop

outputcolumn = 0
i = 0

Next y


For p = 3 To resultoutputrow + 3

Sheets("Output").Cells(p, 1) = output(p, 1)
Sheets("Output").Cells(p, 2) = output(p, 2)
Sheets("Output").Cells(p, 3) = output(p, 3)

If output(p, 2) = "PCREDI" Then Sheets("output").Cells(p, 4) = output(p, 4)
If output(p, 2) = "PINEDI" Then Sheets("output").Cells(p, 4) = ""

If output(p, 2) = "PCREDI" Then Sheets("output").Cells(p, 5) = output(p, 5)
If output(p, 2) = "PINEDI" Then Sheets("output").Cells(p, 5) = output(p, 4)

If output(p, 2) = "PCREDI" Then Sheets("output").Cells(p, 6) = output(p, 6)
If output(p, 2) = "PINEDI" Then Sheets("output").Cells(p, 6) = output(p, 5)

If output(p, 2) = "PCREDI" Then Sheets("output").Cells(p, 7) = output(p, 7)
If output(p, 2) = "PINEDI" Then Sheets("output").Cells(p, 7) = output(p, 6)

If output(p, 2) = "PCREDI" Then Sheets("output").Cells(p, 8) = output(p, 8)
If output(p, 2) = "PINEDI" Then Sheets("output").Cells(p, 8) = output(p, 7)

Next p

Range("H3:H10000").Select
Selection.TextToColumns Destination:=Range("H3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1))
Columns("K:K").ColumnWidth = 18.5






retval = ""

For p = 3 To resultoutputrow

If output(p, 2) = "PCREDI" Then
'
For i = 1 To Len(output(p, 9))

If Mid(output(p, 9), i, 1) >= "0" And Mid(output(p, 9), i, 1) <= "9" Then
retval = retval + Mid(output(p, 9), i, 1)
End If
Next i

Sheets("Output").Cells(p, 12) = retval / 100

retval = ""

End If

If output(p, 2) = "PINEDI" Then

'
For i = 1 To Len(output(p, 8))

If Mid(output(p, 8), i, 1) >= "0" And Mid(output(p, 8), i, 1) <= "9" Then
retval = retval + Mid(output(p, 8), i, 1)
End If
Next i

Sheets("Output").Cells(p, 12) = retval / 100

retval = ""

End If



Next p

For p = 3 To resultoutputrow

If Sheets("Output").Cells(p, 2) = "PCREDI" Then Sheets("Output").Cells(p, 12) = (-1) * Sheets("output").Cells(p, 12)

Lookup = Sheets("Output").Cells(p, 10)
Sheets("Output").Cells(p, 13) = Application.WorksheetFunction.VLookup(Lookup, Sheets("EDI Coding").Range("a3:b1964"), 2, False)

Next p

p = 3








'find last row of output sheet
Dim outputLastRow As Long
With Sheets("Output")
outputLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With


' put a * next to xxxxx invoices
For p = 3 To outputLastRow

For t = 1 To 86
If Sheets("Output").Cells(p, 9) = restnumb(t) Or invoicenumber = Sheets("output").Cells(p, 3) Then xxxxx = True
Next t

If xxxxx = True Then
invoicenumber = Sheets("output").Cells(p, 3)
Sheets("output").Cells(p, 18) = "*"
End If
xxxxx = False


Next p


' Delete rows marked with a *
p = 2
Do Until Count = outputLastRow
Count = Count + 1
p = p + 1
If Sheets("output").Cells(p, 18) <> "*" Then
Rows(p).Delete
p = p - 1
End If
Loop

' delete *
For p = 3 To 3000
Sheets("Output").Cells(p, 18) = ""
Next p


Sheets("output").Cells(3, 1).Select
Sheets("Output").Protect Password:="maverick"


End Sub