VBA Code - Based on Cell Value, macro inputs number into the cell that is next

[haasjoh]

Hi all,

quick question to all VBA pros.

I am having a pretty long table in excel, and in one column ( H5 till H2000 or so) I have values 1 to 5 depending on a grading scheme. Now I want a macro that ones I run it looks at each cell starting in H5 and gives a another value betwenn 0 and 25 in another cell

It should basically work like a grading scheme.

If cell contains 1 then 25 in another cell
If cell contains 2 then 20...
If cell contains 3 then 12.5...
If cell contains 4 then 7.5...
If cell contains 1 then 0...

The cell only can included 1,2,3,4 or 5 - so it works like a grading scheme - I know i could do it also with simple formula without the use of a macro, but I have more columns to go later.


So for example if Cell H10 contains 3 i need in the same row (10) but column S or so (can be flexible) - so offset it by about 10 - the value 12.5

Hope it is clear from my description above what I have in mind.

I figured there might be VBA code that can help.

Many many thanks in advance for the person who can solve it.

Rgds,

[Leith Ross]

Hello hassjoh,

This macro should do what you want. You can add more column letterss to the Array variable Cols as you need them.



Sub Macro1()

Dim Cell As Range
Dim col As Variant
Dim cols As Variant
Dim RngBeg As Range
Dim RngEnd As Range
Dim Wks As Worksheet

Set Wks = ActiveSheet

Set RngBeg = Wks.Range("H5")
Set RngEnd = Wks.Cells(Rows.Count, "H").End(xlUp)

' Check there is data present.
If RngEnd.Row < RngBeg.Row Then Exit Sub

' Add more column leeters as needed. Enclose the letter in
' double quotes and separate the letters using a comma.
cols = Array("S")

For Each Cell In Wks.Range(RngBeg, RngEnd)
For Each col In cols
col = Wks.Cells(1, col).Column

Select Case Cell.Value
Case 1: Cell.Offset(0, col) = 25
Case 2: Cell.Offset(0, col) = 20
Case 3: Cell.Offset(0, col) = 12.5
Case 4: Cell.Offset(0, col) = 7.5
Case 5: Cell.Offset(0, col) = 0
End Select
Next col
Next Cell

End Sub

[haasjoh]

Wow, thank you so much, that works perfectly fine.

Really appreciate your help.

One last thing, if I want the same mechanism but not with a single value in one cell, but rater a range - such that if in one cell I have value 1%-25% I assign 5 to another cell next to it?

thanks in advance,

rgds,

[Leith Ross]

Hello Hello hassjoh,,

The Select Case statement will need to be changed. You can test for a range by using like below.



' Cell value is assumed to be a percentage.
Select Case Cell.Value
Case .01 To .25: Cell.Offset(0, col) = 5
...
End Select