IF THEN ELSEIF VBA Problem

[lorddrezz]

Please Help. Im working on an excel sheet for work that copies our progress notes to certain cells depending on conditions. for some reason if i put jus one if statement in it works one at a time, put thema all together and it doesnt work, just sits there. Ive read several forums and it seems like i got it right but when i click the button for it, nothing happens. Like I said if i put just one if else then it works, all lines nothing. Here is the Code.

Sub CopyDown()
'
' CopyDown Macro
'
'
If B3 = "(RECEIPT)" Then
Range("C4:G4").Select
Selection.Copy
Range("D6:H6").Select
ActiveSheet.Paste
ElseIf B3 = "(ISSUE)" Then
Range("C4:G4").Select
Selection.Copy
Range("D7:H7").Select
ActiveSheet.Paste
ElseIf B3 = "(ROOT CAUSE)" Then
Range("C4:G4").Select
Selection.Copy
Range("D8:H8").Select
ActiveSheet.Paste
ElseIf B3 = "(RESOLUTION)" Then
Range("C4:G4").Select
Selection.Copy
Range("D9:H9").Select
ActiveSheet.Paste
ElseIf B3 = "(Follow up)" Then
Range("C4:G4").Select
Selection.Copy
Range("D10:H10").Select
ActiveSheet.Paste
ElseIf B3 = "(Duplicate)" Then
Range("C4:G4").Select
Selection.Copy
Range("D11:H11").Select
ActiveSheet.Paste
ElseIf B3 = "(Misroute)" Then
Range("C4:G4").Select
Selection.Copy
Range("D12:H12").Select
ActiveSheet.Paste
ElseIf B3 = "(Action required)" Then
Range("C4:G4").Select
Selection.Copy
Range("D13:H13").Select
ActiveSheet.Paste
ElseIf B3 = "(Action taken)" Then
Range("C4:G4").Select
Selection.Copy
Range("D14:H14").Select
ActiveSheet.Paste
Else: MsgBox "Please Enter Free Text"
End If

End Sub

 

[VoG]

It should be like this

If Range("B3").Value = "(RECEIPT)" Then

Also, see http://www.tushar-mehta.com/excel/vba/beyond_the_macro_recorder/

 

[MrKowz]

Welcome to the forums!

You can't refer to the range as just "B3". You need to refer to it with either Range("B3").Value or Cells(3,2).Value.

Also, since you are checking the value of a single cell, where each value does a different thing. This is often called a "Case", and can be handled easier with a Select Case block:

Sub CopyDown()
'
' CopyDown Macro
'
'
Select Case Range("B3").Value
    Case "(RECEIPT)"
        Range("C4:G4").Copy Destination:=Range("D6")
    Case "(ISSUE)"
        Range("C4:G4").Copy Destination:=Range("D7")
    Case "(ROOT CAUSE)"
        Range("C4:G4").Copy Destination:=Range("D8")
    Case "(RESOLUTION)"
        Range("C4:G4").Copy Destination:=Range("D9")
    Case "(Follow up)"
        Range("C4:G4").Copy Destination:=Range("D10")
    Case "(Duplicate)"
        Range("C4:G4").Copy Destination:=Range("D11")
    Case "(Misroute)"
        Range("C4:G4").Copy Destination:=Range("D12")
    Case "(Action required)"
        Range("C4:G4").Copy Destination:=Range("D13")
    Case "(Action taken)"
        Range("C4:G4").Copy Destination:=Range("D14")
    Case Else
        MsgBox "Please Enter Free Text"
End Select
End Sub

 

[JackDanIce]

Welcome to the board.

Not a great idea to nest lots of IF ELSEIF conditions, suggest you use CASE SELECT statements instead:
http://www.ozgrid.com/VBA/select-case.htm

Anyway, try:

Sub Macro1 ()

Dim mSource As Range

Application.ScreenUpdating = False

Set mSource = Range("C4:G4")

Select Case UCase(Range("B3"))
    Case "(RECEIPT)"
        mSource.Copy Range("D6:H6")
    Case "(ISSUE)"
        mSource.Copy Range("D7:H7")
    Case "(ROOT CAUSE)"
        mSource.Copy Range("D8:H8")
    Case "(RESOLUTION)"
        mSource.Copy Range("D9:H9")
    Case "(FOLLOW UP)"
        mSource.Copy Range("D10:H10")
    Case "(DUPLICATE)"
        mSource.Copy Range("D11:H11")
    Case "(MISROUTE)"
        mSource.Copy Range("D12:H12")
    Case "(ACTION REQUIRED)"
        mSource.Copy Range("D13:H13")
    Case "(ACTION TAKEN)"
        mSource.Copy Range("D14:H14")
    Case Else
        MsgBox "Please Enter Free Text"
End Select

Application.ScreenUpdating = True

End Sub

 

[MrKowz]

Another possibility using Application.Match to return a value that designates how far to "offset" the paste:

Sub CopyDown()
Dim x As Variant
x = Application.Match(Range("B3").Value, Array("(RECEIPT)", "(ISSUE)", "(ROOT CAUSE)", "(RESOLUTION)", _
                                               "(Follow up)", "(Duplicate)", "(Misroute)", "(Action Required)", _
                                               "(Action taken)"), 0)
If Not IsError(x) Then
    Range("C4:G4").Copy Destination:=Range("D6").Offset(x - 1, 0)
Else
    MsgBox "Please Enter Free Text"
End If
End Sub

 

[lorddrezz]

Beautiful, thanks alot guys. This will save me a ton of time at work.

 

[MrKowz]

Beautiful, thanks alot guys. This will save me a ton of time at work.

Happy to be of assistance. Thank you for the feedback.