Help Modifying ListFill code to enter cell Formulas

[ctild]

Being new to VB I have aquired a Listfill code that deletes a the Players Row when selected from the list.

I'd like to use the same code, only this time modify 3 cells on the selected Players row.

The code I have is:-

    With ListBox1
    If .ListIndex = -1 Then
    MsgBox "You did not select anyone in the list ?", 48, "Cannot continue."
    Exit Sub
End If

    Dim i&, xRow&, strSelected$
For i = 0 To .ListCount - 1
    If .Selected(i) = True Then
    xRow = i + 1
    Exit For
End If

    
    Application.ScreenUpdating = False
    Next i
    strSelected = .List(.ListIndex)
    'A little safer using Find than xRow = i
        xRow = Sheets(1).Columns(2).Find(What:=strSelected, LookIn:=xlFormulas, LookAt:=xlWhole).Row
    Dim myConf%
        myConf = MsgBox("You selected:-  " & strSelected & vbCrLf & vbCrLf _
        & "Are you sure want to delete this Player?", 36, "Please confirm")
        If myConf = 7 Then
        MsgBox "No problem, nothing will be deleted.", 64, "You clicked No."
    Exit Sub
End If

End With
    Application.ScreenUpdating = False
    With Sheets(1)
    .Rows(xRow).Delete
    ListBox1.Clear
    ListBox1.List = .Range("B10").Resize(.Range("B10").CurrentRegion.Rows.Count, 1).Value
End With

    Range("D6").Select
    Application.ScreenUpdating = True
    
    Unload Me
    MsgBox "Player has been deleted.", 64, "Done"

What I need is for it to be modified to find the selected Players row, then select and modify the following 3 cells along that row, as below.

    ' Selected Row @ Column "J)
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    Selection.Font.ColorIndex = 3
    Selection.Interior.ColorIndex = 6
    Selection.Interior.Pattern = xlSolid

    ' Selected Row @ Column "S"
    ActiveCell.FormulaR1C1 = _
        "=IF(J10>=50,4,IF(J10>=45,3,IF(J10>=40,2,IF(J10>=38,1,IF(J10<=37,0)))))"
    
    ' Selected Row @ Column "T"
    ActiveCell.FormulaR1C1 = _
        "=IF(F10<10,1,IF(S10=1,2,1))"

I can modify the messages later.

Any help appreciated.

 

[Norie]

So for the player selected in the listbox you want to do this for the row on the worksheet the player data is in.

What rows in column B have player data?

Is it from row 10 down?

You could try something like this, untested, code.

If Listbox1.ListIndex <> -1 Then

     lngRow = Listbox1.ListIndex+10  

     With Range("J"& lngRow)
           .Font.Bold = True
           .Font.Underline = xlUnderlineStyleSingle
           .Font.ColorIndex = 3
           .Interior.ColorIndex = 6
           .Interior.Pattern = xlSolid
     End With

     Range("S"& lngRow).Formula =_  "=IF(J10>=50,4,IF(J10>=45,3,IF(J10>=40,2,IF(J10>=38,1,IF(J10<=37,0)))))"
    
    Range("T"& lngRow).Formula = _
        "=IF(F10<10,1,IF(S10=1,2,1))"
End If

Oops just noticed the listbox is multi select, the above code is for a single select listbox.

Sorry.

 

[ctild]

Thanks for the quick reply Norie.

It inserts as the requirements required and is a good starter for me to work on.

Much appreciated.

 

[Norie]

Do you want to do this for every selected player in the listbox?

That should be straightforward.

For I =0 To Listbox1.ListCount-1
      If Listbox1.Selected(I) Then

           lngRow = I +10
           
           ' code for formatting and formulas

      End If

Next I

The code for the formatting and formulas is just the same as for a single select.

 

[ctild]

Hi Norie.

Your earlier code worked great.

I've now inserted my own code lines and it runs really well.

Thanks again