Search cell

I have a macro that I am trying to get something done. I want it to search a range of cells from E2:P13. If it contains a "1" then copy cell B27 to that cell and repeat for all cells in that range. If it contains a "2" then copy cell C27 to that cell.

I had a VB class in college and wrote this, but I would have to copy and paste it for each cell and if I add a row it would not be easy to change.

If Range("E2").Value = "1" Then
        Range("B27").Select
        Selection.Copy
        Range("E2").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
    ElseIf Range("E2").Value = "2" Then
        Range("C27").Select
        Selection.Copy
        Range("E2").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
    End If

Can anyone help with something more "dynamic"?

Thanks!

You can loop through cells using a Range object like this:

Dim rngLoopRange As Range

For Each rngLoopRange In Range("E2:P13")

    Select Case rngLoopRange.Value
    
        Case 1
                
            rngLoopRange = Range("B27")
                
        Case 2
            
            rngLoopRange = Range("C27")
                
    End Select
        
Next rngLoopRange

Hope it helps,

Dom

Originally Posted by esullivan

So how would I tell it do paste in the cell it's found a match for? I am sorry, I know BASIC VB, but this is kind of over my head.

Thanks

Did you try the code I posted? It should do everything you described in your original post.

Dom

Oh wow, yeah it does thanks. Except it on;y copies the value not the formatting. I have fill colors and text colors that need to be changed.

Thanks again for all your help by the way!

Try this:

Dim rngLoopRange As Range

Application.ScreenUpdating = False

For Each rngLoopRange In Range("E2:P13")

    Select Case rngLoopRange.Value
    
        Case 1
                
            Range("B27").Copy rngLoopRange
                
        Case 2
            
            Range("C27").Copy rngLoopRange
                
    End Select
    
Application.CutCopyMode = False
Application.ScreenUpdating = True

Next rngLoopRange

Dom