Is target.offset my answer? Adapting code to format an adjacent cell.

**thespianchef** · 01-16-2012, 05:53 PM

Hi All,

I am a novice when it comes to coding in excel but had managed to write the below which does a few things to a cell in my range (G3:G32) when a number between 0 and 100 is entered:

It gets rid of the "Enter Maths %" in red font
It formats the cell as black font
It replaces the score with a category such as well below average (such as my vba skills!)
It fills the cell with color corresponding to the category

However, I now realize that I want to reuse the percentages for the class which are added to G3:G32. As such, I would prefer to apply all of these formats, which refer to a specific row in column G, to the adjacent cell in column H, thus retaining the percentage scores. How can this be done? I was playing a little with target.offset but I don't know whether that is my answer. Any advice would be greatly appreciated

Thanks all.

Mike

'Maths % code
Dim MyRng7 As Range
Dim i7 As Range
Set MyRng7 = Range("G3:G32")
For Each i7 In MyRng7
    If IsEmpty(i7) Then
        i7.Font.ColorIndex = 3
        i7 = "Enter Maths %"
    Else
        i7.Font.ColorIndex = 1
    End If
    
    If i7 = "Enter Maths %" Then
        i7.Font.ColorIndex = 3
    End If
     
    Select Case i7
    Case 0 To 16
        i7 = "Well below av"
        i7.Interior.ColorIndex = 3
    Case 16 To 30
        i7 = "Below average"
        i7.Interior.ColorIndex = 45
    Case 30 To 70
        i7 = "Average"
        i7.Interior.ColorIndex = 6
    Case 70 To 84
        i7 = "Above average"
        i7.Interior.ColorIndex = 43
    Case 84 To 100
        i7 = "Well above av"
        i7.Interior.ColorIndex = 4
    Case ""
        i7.Interior.ColorIndex = xlNone
    Case "Enter Maths %"
        i7.Interior.ColorIndex = xlNone
    End Select

Next i7

**TMShucks** · 01-16-2012, 08:52 PM

It wouldn't be Target.Offset. It would be I7.Offset(0,1). Target is used for the range in some event handlers.

But you're doing comparisons and changing things on the basis of what was there or what it's been changed to so the logic might need to change.

Regards, TMS

**thespianchef** · 01-17-2012, 11:02 PM

Thanks TM! I Think I am nearly there although each time I now run the below code it formats the adjacent cell with the text but not the fill color but then crashes. Any ideas?

Thanks once again.

Michael

'Maths % code
Dim MyRng7 As Range
Dim i7 As Range
Set MyRng7 = Range("F3:F32")
For Each i7 In MyRng7
    If IsEmpty(i7) Then
        i7.Font.ColorIndex = 3
        i7 = "Enter Maths %"
    Else
        i7.Font.ColorIndex = 1
    End If
    
    If i7 = "Enter Maths %" Then
        i7.Font.ColorIndex = 3
    End If
     
    Select Case i7
    Case 0 To 16
        i7.Offset(0, 1) = "Well below av"
        i7.Offset(0, 1).Interior.ColorIndex = 3
    Case 16 To 30
        i7.Offset(0, 1) = "Below average"
        i7.Offset(0, 1).Interior.ColorIndex = 45
    Case 30 To 70
        i7.Offset(0, 1) = "Average"
        i7.Offset(0, 1).Interior.ColorIndex = 6
    Case 70 To 84
        i7.Offset(0, 1) = "Above average"
        i7.Offset(0, 1).Interior.ColorIndex = 43
    Case 84 To 100
        i7.Offset(0, 1) = "Well above av"
        i7.Offset(0, 1).Interior.ColorIndex = 4
    End Select

Next i7

**TMShucks** · 01-18-2012, 12:46 AM

To best describe or illustrate your problem you would be better off attaching a dummy workbook, the workbook should contain the same structure and some dummy data of the same type as the type you have in your real workbook - so, if a cell contains numbers & letters in this format abc-123 then that should be reflected in the dummy workbook. Don't upload a picture when you have a workbook question. None of us is inclined to recreate your data. Upload the workbook and manually add an 'after' situation so that we can see what you expect. In addition clearly explain how you get the results..
To attach a file to your post, you need to be using the main 'New Post' or 'New Thread' page and not 'Quick Reply'.
To use the main 'New Post' page, click the 'Post Reply' button in the relevant thread.

On this page, below the message box, you will find a button labelled 'Manage Attachments'.
Clicking this button will open a new window for uploading attachments.

You can upload an attachment either from your computer or from another URL by using the appropriate box on this page.
Alternatively you can click the Attachment Icon to open this page.

To upload a file from your computer, click the 'Browse' button and locate the file.

To upload a file from another URL, enter the full URL for the file in the second box on this page.
Once you have completed one of the boxes, click 'Upload'.

Once the upload is completed the file name will appear below the input boxes in this window.
You can then close the window to return to the new post screen.

**jolivanes** · 01-18-2012, 12:50 AM

Is this what you mean?

Sub TryThis()
Dim myRng As Range
Dim c As Range
Set myRng = Range("G3:G32")
For Each c In myRng
    If IsEmpty(c) Then
        c.Value = "Enter Maths %"
        c.Font.ColorIndex = 3
    Else
        c.Font.ColorIndex = 1
    End If

    Select Case c.Value
    Case 0 To 16
        c.Offset(,1).Value = "Well below av"
        c.Interior.ColorIndex = 3
    Case 16 To 30
        c.Offset(,1).Value = "Below average"
       c.Interior.ColorIndex = 45
    Case 30 To 70
       c.Offset(,1).Value = "Average"
        c.Interior.ColorIndex = 6
    Case 70 To 84
        c.Offset(,1).Value = "Above average"
        c.Interior.ColorIndex = 43
    Case 84 To 100
        c.Offset(,1).Value = "Well above av"
        c.Interior.ColorIndex = 4
    Case ""
        c.Interior.ColorIndex = xlNone
    Case "Enter Maths %"
        c.Interior.ColorIndex = xlNone
    End Select
Next
End Sub

**thespianchef** · 01-18-2012, 09:29 PM

Thanks TMS and Jolivanes. I didn't upload a dataset as the code populates the cells automatically. However, with Jolivanes code and stopping the recursive steps by using enableevents I have the below code which I use in the worksheet change module and which works! Thank you both so much for your help. The code is very simple but populates A1:A10 and then changes values in adjacent B cells accordingly depending on the value of the score.

Thanks once again.

Michael

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range
Dim c As Range
Set myRng = Range("A1:A10")
For Each c In myRng
    Application.EnableEvents = False
    If IsEmpty(c) Then
        c.Value = "Enter Maths %"
        c.Font.ColorIndex = 3
    Else
        c.Font.ColorIndex = 1
    End If

    If c.Value = "Enter Maths %" Then
        c.Font.ColorIndex = 3
    End If
    
    Select Case c.Value
    Case 0 To 16
        c.Offset(, 1).Value = "Well below av"
        c.Offset(, 1).Interior.ColorIndex = 3
    Case 16 To 30
        c.Offset(, 1).Value = "Below average"
       c.Offset(, 1).Interior.ColorIndex = 45
    Case 30 To 70
       c.Offset(, 1).Value = "Average"
        c.Offset(, 1).Interior.ColorIndex = 6
    Case 70 To 84
        c.Offset(, 1).Value = "Above average"
        c.Offset(, 1).Interior.ColorIndex = 43
    Case 84 To 100
        c.Offset(, 1).Value = "Well above av"
        c.Offset(, 1).Interior.ColorIndex = 4
    Case ""
        c.Offset(, 1).Interior.ColorIndex = xlNone
    Case "Enter Maths %"
        c.Offset(, 1).Interior.ColorIndex = xlNone
    Application.EnableEvents = True
    End Select
Next
End Sub

**TMShucks** · 01-18-2012, 09:55 PM

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save

**jolivanes** · 01-18-2012, 11:25 PM

BTW, I would change the "Case 16 To 30" to "Case 17 To 30". You have 16 already in "Case 0 To 16".
Same for the other Cases.

HTH
John

**thespianchef** · 01-19-2012, 03:18 PM

THanks John and TMS. I have the select code "overlapping" as in the instance of 16 because on the upper end excel treats 16 as 16.00, on the lower end it treats 16 as 16.01. So I put 17 as the lower bound for the second category and then there is a score of 16.5% this does not get formatted.

So my final code is:

Private Sub Worksheet_Change(ByVal Target As Range)

'Maths % code
Dim myRng As Range
Dim c As Range
Set myRng = Range("A1:A10")
For Each c In myRng
Application.EnableEvents = False
If IsEmpty(c) Then
c.Value = "Enter Maths %"
c.Font.ColorIndex = 3
Else
c.Font.ColorIndex = 1
End If

If c.Value = "Enter Maths %" Then
c.Font.ColorIndex = 3
End If

Select Case c.Value
Case 0 To 16
c.Offset(, 1).Value = "Well below av"
c.Offset(, 1).Interior.ColorIndex = 3
Case 16 To 30
c.Offset(, 1).Value = "Below average"
c.Offset(, 1).Interior.ColorIndex = 45
Case 30 To 70
c.Offset(, 1).Value = "Average"
c.Offset(, 1).Interior.ColorIndex = 6
Case 70 To 84
c.Offset(, 1).Value = "Above average"
c.Offset(, 1).Interior.ColorIndex = 43
Case 84 To 100
c.Offset(, 1).Value = "Well above av"
c.Offset(, 1).Interior.ColorIndex = 4
Case ""
c.Offset(, 1).Value = ""
c.Offset(, 1).Interior.ColorIndex = xlNone
Case "Enter Maths %"
c.Offset(, 1).Value = ""
c.Offset(, 1).Interior.ColorIndex = xlNone
Application.EnableEvents = True
End Select
Next c

End Sub

Best wishes,

Michael