VBA, input box don't work with multiple selection

[ToseSenpai]

Hi all, i need some help for this vba code! Can you please help me?
I got this VBA code that allows me to insert a value (with a input box) in a active cell and then fill cell with a certain color.
It works perfecly when i select only one cell, but how can i do that with multiple selection?

Thank you very much for your help

Sub ButtonInsert()

  
    Dim cell As Object
    Dim Count As Integer
  
On Error Resume Next
   Dim dblAmount As Double
   dblAmount = InputBox("Insert Hours", "Insert")
   If dblAmount <> 0 Then
      ActiveCell = dblAmount
   Else
      MsgBox "You must insert a number"
 Exit Sub
   End If


Count = 0
    For Each cell In Selection
        Count = Count + 1
    Next cell

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

  
    ActiveSheet.Calculate
End Su

 

[NdNoviceHlp]

This seems to work. HTH. Dave

Sub ButtonInsert()   
   Dim cel As Range
    Dim Count As Integer
  
'On Error Resume Next
   Dim dblAmount As Double
   dblAmount = InputBox("Insert Hours", "Insert")
   If dblAmount = 0 Then
      'ActiveCell = dblAmount
   'Else
      MsgBox "You must insert a number"
 Exit Sub
   End If


Count = 0
    For Each cel In Selection
        Count = Count + 1
    cel.Value = dblAmount

    With cel.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Next cel
  
    ActiveSheet.Calculate
End Sub

 

[Rick Rothstein]

Try changing this...

ActiveCell = dblAmount

to this...

Selection = dblAmount

 

[ToseSenpai]

Try changing this...

ActiveCell = dblAmount

to this...

Selection = dblAmount

Thank you, it works perfectly