Changing numbers to characters by using range values

S

spolk

Hi now I faced a new problem:

I wanted to make the following system

If in Column A values are:

Value=0 ,will be changed to N
Value > 0 and < 2 will be changed to V
Value > 2 and < 5 will be changed to F

Here is my code

'Here is determined stone/gravel abundance sbhm_stgr/sbhe_stgr

Dim grv As Long
Application.ScreenUpdating = False

For grv = 1 To Worksheets("Horizon_Measurements").Cells(Rows.Count
"S").End(xlUp).Row
If (Cells(grv, "S").Value) = 0 Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value = "N"
ElseIf Worksheets("Horizon_Measurements").Cells(grv, "S").Value >
< 2 Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value = "C"
ElseIf Worksheets("Horizon_Measurements").Cells(grv, "S").Value >
< 5 Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value = "F"
ElseIf Worksheets("Horizon_Measurements").Cells(grv, "S").Value >
< 15 Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value = "C"
ElseIf Worksheets("Horizon_Measurements").Cells(grv, "S").Value
15 < 40 Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value = "M"
ElseIf Worksheets("Horizon_Measurements").Cells(grv, "S").Value
40 < 90 Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value = "A"
ElseIf Worksheets("Horizon_Measurements").Cells(grv, "S").Value
90 Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value = "D"
End If


Next grv


This code produces characters but not correctly, for example if I pu
the value 91 to cell S2 the macro gives letter C instead of letter D
My code works somehow, but not properly, what i'am doing wrong
 
P

pikus

Here. Try this. The way you had it set up, any cell with a value of
for example, exactly two, wouldn't be changed. If you have an
questions about what I did, please let me know. ALSO, I have no
tested this, but it works in theory... - Pikus

Dim grv As Long
Dim lrow As Long
Application.ScreenUpdating = False

With Worksheets("Horizon_Measurements")
lrow = .UsedRange.Row - 1 + .UsedRange.Rows.Count
For grv = 1 To lrow
If (Cells(grv, 19).Value) = 0 Then
.Cells(grv, 19).Value = "N"
ElseIf .Cells(grv, 19).Value > 0 And .Cells(grv, 19).Value <= 2 Then
.Cells(grv, 19).Value = "C"
ElseIf .Cells(grv, 19).Value > 2 And .Cells(grv, 19).Value <= 5 Then
.Cells(grv, 19).Value = "F"
ElseIf .Cells(grv, 19).Value > 5 And .Cells(grv, 19).Value <= 15 Then
.Cells(grv, 19).Value = "C"
ElseIf .Cells(grv, 19).Value > 15 And .Cells(grv, 19).Value <= 40 Then
.Cells(grv, 19).Value = "M"
ElseIf .Cells(grv, 19).Value > 40 And .Cells(grv, 19).Value <= 90 Then
.Cells(grv, 19).Value = "A"
ElseIf .Cells(grv, 19).Value > 90 Then
.Cells(grv, 19).Value = "D"
End If
Next grv
End With

Application.ScreenUpdating = Tru
 
S

spolk

Thanks,pikus, the code is working, still needs some fine tuning, i
changes also the text in S1 to letter D and when I run it second tim
it will change all letters to letter D as well

But the main idea is working. I am wondering how big my macro will b
when finished all this business..
 
P

pikus

That's funny... Just for kicks, try changing this:

For grv = 1 To lrow
If (Cells(grv, 19).Value) = 0 Then
...
ElseIf .Cells(grv, 19).Value > 90 Then
.Cells(grv, 19).Value = "D"
End If
Next grv


to:

For grv = 1 To lrow
If IsNumeric(.Cells(grv, 19).Value) Then
If (.Cells(grv, 19).Value) = 0 Then
...
ElseIf .Cells(grv, 19).Value > 90 Then
.Cells(grv, 19).Value = "D"
End If
End If
Next grv

Do you get what I'm going for?

- Piku
 
D

Dana DeLouis

Maybe just a general idea. You did not specify which value to use when the
value is exactly 2, 5, 15 ...etc. With "C" listed twice, this makes it
difficult to arrive at a simpler equation.

Sub Demo()
Dim Rng As Range
Dim Cell As Range
Dim LookFor
Dim ReturnValue

LookFor = Array(0, 0.00001, 2, 5, 15, 40, 90)
ReturnValue = Array("N", "C", "F", "C", "M", "A", "D")

On Error Resume Next
Set Rng = Columns("S:S").SpecialCells(xlCellTypeConstants, xlNumbers)
If Rng Is Nothing Then Exit Sub
With WorksheetFunction
For Each Cell In Rng.Cells
Cell.Value = .Lookup(Cell.Value, LookFor, ReturnValue)
Next Cell
End With
End Sub
 
S

spolk

Hi, the problem became depended on two variables, the soil species an
stone/gravel abundance, but somehow it became easier to solve, so her
is the code, who gives a new value to different worksheet from basis o
two old variables



'Here is determined stone/gravel abundance sbhm_stgr/sbhe_stgr

Dim grv As Long
Application.ScreenUpdating = False
For grv = 1 To Cells(Rows.Count, "H").End(xlUp).Row
If LCase(Cells(grv, "H").Value) = "as" And (Cells(grv
"AC").Value) = "0" Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value
"N0"
ElseIf LCase(Cells(grv, "H").Value) = "as" And (Cells(grv
"AC").Value) > 0 And (Cells(grv, "AC").Value <= 2) Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value
"VF"
ElseIf LCase(Cells(grv, "H").Value) = "as" And (Cells(grv
"AC").Value) > 2 And (Cells(grv, "AC").Value <= 5) Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value
"FF"
ElseIf LCase(Cells(grv, "H").Value) = "as" And (Cells(grv
"AC").Value) > 5 And (Cells(grv, "AC").Value <= 15) Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value
"CF"
ElseIf LCase(Cells(grv, "H").Value) = "as" And (Cells(grv
"AC").Value) > 15 And (Cells(grv, "AC").Value <= 40) Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value
"MF"
ElseIf LCase(Cells(grv, "H").Value) = "as" And (Cells(grv
"AC").Value) > 40 And (Cells(grv, "AC").Value <= 90) Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value
"AF"
ElseIf LCase(Cells(grv, "H").Value) = "as" And (Cells(grv
"AC").Value) > 90 Then
Worksheets("Horizon_Measurements").Cells(grv, "S").Value
"DF"

End If

Next grv
End Su
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top