Problem w/ block of code- Formatting Fractions

[YellowLabPro]

This block works as is, it changes the targeted cells to Text and adds a double quote to the end.

However- I wish to remove the double quote from the end.

1 1/2 is the value evaluated, it has a cell fractional format. The first block of code changes it to 1 1/2" and the cell format is now Text.

I wish to change it to 1 1/2 only and the cell format to Text. If I remove the two double quotes from the end, my results end up w/ a #Value!

This code is supposed to only evalueate cells in col. M w/ a value greater than zero, it is evaluating all cells, and if the cell is blank, it is returning a zero (0) value in col M.

Returns value w/ " on the end
[VBA]For i = 4 To LRowf
If Cells(i, "G").Text = "HWBLTS" Or Cells(i, "G").Text = "HWRISR" _
And IsNumeric(Cells(i, "M").Value) > 0 Then
Cells(i, "M").Value = Application.Text(Cells(i, "M").Value, "# ##/##\""")
End If
Next i[/VBA]

Returns #Value! error
[VBA]For i = 4 To LRowf
If Cells(i, "G").Text = "HWBLTS" Or Cells(i, "G").Text = "HWRISR" _
And IsNumeric(Cells(i, "M").Value) > 0 Then
Cells(i, "M").Value = Application.Text(Cells(i, "M").Value, "# ##/##\")
End If
Next i[/VBA]

A thought I have is instead of using this line:
And IsNumeric(Cells(i, "M").Value) > 0 Then
can a Length function be added to it, so it would be IsNumeric and Length is > 0

Syntax would be
And IsNumeric(Len(Cells(i, "M").Value)) > 0 Then

[rory]

How about:
[VBA]For i = 4 To LRowf
If (Cells(i, "G").Text = "HWBLTS" Or Cells(i, "G").Text = "HWRISR") _
And IsNumeric(Cells(i, "M").Value) Then
With Cells(i, "M")
If .Value > 0 Then
.NumberFormat = "@"
.Value = .Text
End If
End With
End If
Next i
[/VBA]

Regards,
Rory

[Bob Phillips]

How about this

[vba]

For i = 4 To LRowf
If Cells(i, "G").Text = "HWBLTS" Or Cells(i, "G").Text = "HWRISR" _
And IsNumeric(Cells(i, "M").Value) > 0 Then
Cells(i, "M").Value = Application.Text(Cells(i, "M").Value, "# ##/##")
End If
Next i
[/vba]

[YellowLabPro]

Thanks guys,
Bob- getting rid of the escape backslash works partially. It allows the code to run. It does not change the cell format to a textformat, (and maybe it is not supposed to- can you let me know about this?). I placed the leading single quote in the numberformat and that makes it appear as a fraction in the formula bar rather than a decimal; " '# ##/##"

I would still like to change the cell format to a textformat rather than a fraction. Depending on your answer from the top question will lead me into how to proceed.

The other problem is that it still is placing a zero on col. M when no value exists at all.

I am testing on a blank sheet set up to simulate my working sheet- so I see no other issue that would be influencing this at the moment.

[YellowLabPro]

Rory,
Sorry to keep doing this to you. I want to see where my issue is here before abandoning it. I want to work it out first....
I am testing your code now to see what results we get

[rory]

OK, no problem. I should have mentioned that my version assumes the cell is already formatted as a fraction (without the quote at the end)

[Bob Phillips]

[vba]

For i = 4 To LRowf
If Cells(i, "G").Text = "HWBLTS" Or Cells(i, "G").Text = "HWRISR" _
And IsNumeric(Cells(i, "M").Value) > 0 Then
Cells(i, "M").Value = "'" & Application.Text(Cells(i, "M").Value, "# ##/##")
End If
Next i
[/vba]

[YellowLabPro]

Bob,
Both of these give same exact results- sorry if I am missing something.
I still also end up w/ a zero (0) in a cell that was empty initially.

[vba]'For i = 4 To 20
' If Cells(i, "G").Text = "HWBLTS" Or Cells(i, "G").Text = "HWRISR" _
' And IsNumeric(Cells(i, "M").Value) > 0 Then
' Cells(i, "M").Value = "'" & Application.Text(Cells(i, "M").Value, "'# ##/##")
' End If
' Next i

For i = 4 To 20
If Cells(i, "G").Text = "HWBLTS" Or Cells(i, "G").Text = "HWRISR" _
And IsNumeric(Cells(i, "M").Value) > 0 Then
Cells(i, "M").Value = "'" & Application.Text(Cells(i, "M").Value, "# ##/##")
End If[/vba]

Bob, edited- I had it correct in my test code, but pasted the wrong line. I did have the single quote in the first block of code.

[YellowLabPro]

Rory,
The issue w/ how your code handles fractions is what Bob and I had been working on. Once you run your code through a cell that is a fractional value, whether it be a mixed number or fraction, it changes the value to a decimal. I cannot show that, it needs to retain its fractional appearance.

On the upside, yours does not place a zero value in a blank cell, it remains empty.

[Bob Phillips]

This works for me Doug with the combinations I can think of

[vba]
For i = 4 To 20
If (Cells(i, "G").Text = "HWBLTS" Or Cells(i, "G").Text = "HWRISR") And _
Cells(i, "M").Value > 0 Then
Cells(i, "M").Value = "'" & Application.Text(Cells(i, "M").Value, "# ##/##")
End If
[/vba]

[Bob Phillips]

There is no point trying to keep two threads going in one, so I will bow out now.

[rory]

That's because I'm an idiot - it should have been:
[VBA]For i = 4 To LRowf
If (Cells(i, "G").Text = "HWBLTS" Or Cells(i, "G").Text = "HWRISR") _
And IsNumeric(Cells(i, "M").Value) Then
With Cells(i, "M")
If .Value > 0 Then
strtext = .Text
.NumberFormat = "@"
.Value = strtext
End If
End With
End If
Next i
[/VBA]

Regards,
Rory

[YellowLabPro]

Rory,
strText is asking to be declared as a variable- is this correct or is it a keyword?

[rory]

It should be declared as a String.
Regards,
Rory

[YellowLabPro]

Rory-
Very clever. I see that you pick up the value from the .Text and replace the decimal w/ the fractional value once you have changed the cell format.
I am going to test on a few more items and then post back.

thank you

[YellowLabPro]

Bob,
Fair enough, but I would like to continue this w/ you. Yes it was getting confusing, sorry about that. Possibly later we could discuss this, there are things about this I still don't understand, and would like to understand better.

[YellowLabPro]

Rory,
Can you help adapt the code that you wrote earlier to handle the additional spaces between the whole number value and the fraction.
1 1/4 will become 1 1/4.

I tried, but w/out any success. I tried changing the line in the function that is "# " to "@" or "@ " and that had no effect.

I am posting back up the original Sub and Function for this;

[VBA]
Sub GetFractionFormat()
Dim rngcell As Range
Dim Item As Variant
Dim i As Integer

For i = 4 To 20
For Each Item In Array("HAT", "FTWR", "BOOT", "BOOTW", "BOOTY", "HWRISR", "HWBLTS")
If (Cells(i, "F").Value = Item Or Cells(i, "G").Value = Item) Then
'this will change all formating in the selection if a match to Item is found
'For Each rngcell In Range("M4:M12000") 'Selection
On Error Resume Next
'changed this to check the cell on the row that matches the array
With Cells(i, "M")
If .Value <> Int(.Value) And Len(.Value) > 0 Then
.Numberformat = "# ??/??"
.Numberformat = GetFractionFormat(.Text)
.Formula = .Value
End If
End With
'Next rngcell 'Exit For
On Error GoTo 0
End If
Next Item
'Exit For
Next i
MsgBox "Done"
End Sub

Function GetFractionFormat(strText As String) As String
Dim intSpace As Integer, intDivisor As Integer
Dim strNumerator As String, strDenominator As String
strText = Trim$(strText)
intSpace = InStr(strText, " ")
intDivisor = InStr(strText, "/")
strNumerator = String(Len(Trim$(Mid$(strText, intSpace + 1, intDivisor - intSpace - 1))), "?")
strDenominator = String(Len(Trim$(Right$(strText, Len(strText) - intDivisor))), "?")
GetFractionFormat = "# " & strNumerator & "/" & strDenominator
End Function
[/VBA]

[rory]

You've lost me - what needs fixing?

[YellowLabPro]

Hang on to this for a little bit.
I am working on a different part of it now.

How about this line of code-
This gets a Type Mismatch-[VBA]If IsNumeric(Cells(i, "M").Value) = Int(Cells(i, "M").Value) Then[/VBA]I want to determine if the number is a whole number.

[YellowLabPro]

Rory,
I got it worked out, so you need'nt spend any time on the formula.
I am still working through the procedure. I will post back when I am at a good stopping point.
[VBA]
If IsNumeric(Cells(i, "M").Value) And Cells(i, "M").Value > 0 And Cells(i, "M").Value / Int(Cells(i, "M").Value) = 1 Then
Cells(i, "M").NumberFormat = "General"
[/VBA]
Thanks