VBA Copying Range Based on Cell Value

[Syncert]

Hi Again! I'm very new to VBA. I'm creating a macro to copy a range based upon a singular cell's value on an active sheet.

Sub copyreport()


If ActiveSheet.Range("W25").Value <= "5" Then
Range("A1:X37").Select
Range("X37").Activate
Application.CutCopyMode = False
Selection.Copy


ElseIf ActiveSheet.Range("W25").Value <= "10" Then
Range("A1:X45").Select
Range("X45").Activate
Application.CutCopyMode = False
Selection.Copy


ElseIf ActiveSheet.Range("W25").Value <= "15" Then
Range("A1:X53").Select
Range("X53").Activate
Application.CutCopyMode = False
Selection.Copy


ElseIf ActiveSheet.Range("W25").Value <= "20" Then
Range("A1:X61").Select
Range("X61").Activate
Application.CutCopyMode = False
Selection.Copy

End If




End Sub


What am I doing wrong in this setup? It doesn't copy the range if the Cell = 6 or 19. Cell W25 is only supposed to equal 1-20.

Thanks,

 

[Yongle]

Re: VBA Code Help - Copying Range Based on Cell Value

You told VBA to copy something, but not where to paste (see NOTE below)
- Using your code you could have achieved the correct results with this

If ActiveSheet.Range("W25").Value <= [COLOR=#ff0000]5[/COLOR] Then    [I][COLOR=#006400] 'numbers are NOT placed  inside [/COLOR][/I][COLOR=#ff0000]"  "[/COLOR]
    ActiveSheet.Range("A1:X37").Copy Destination:=ActiveSheet.Range("X37")

etc
End If

I think this is what you are trying to achieve

Note in particular
- numbers are NOT placed inside" " (which is notation used for strings)
- sheets and ranges usually do NOT require selecting
- use of variables to avoid repitition
- variable type for v (a number) could be Single, Double, Integer or Long - Double allows for decimal values - so a safe bet here!
- use of With ... End With construction
- all ranges are qualified with a sheet reference
- here qualified using With ActiveSheet .. and .Range - which is the same as ActiveSheet.Range

Sub copyreport()
    Dim rng As Range, cel As Range, v As Double
  
    With ActiveSheet
        v = .Range("W25")
        If v <= 5 Then
            Set rng = .Range("A1:X37")
            Set cel = .Range("X37")
        ElseIf v <= 10 Then
            Set rng = .Range("A1:X45")
            Set cel = .Range("X45")
        ElseIf v <= 15 Then
            Set rng = .Range("A1:X53")
            Set cel = .Range("X53")
        ElseIf v <= 20 Then
            Set rng = .Range("A1:X61")
            Set cel = .Range("X61")
        End If
[I][COLOR=#006400]'if one of the values met the criteria then copy the correct range[/COLOR][/I]
        If Not rng Is Nothing Then rng.Copy Destination:=cel
        
    End With
End Sub

Select Case instead of If and ElseIf
- in this instance I would probably have used Select Case which is less cumbersome (but does exactly the same job)

Sub copyreport2()
    Dim rng As Range, cel As Range
    With ActiveSheet
        Select Case .Range("W25")
            Case Is <= 5
                Set rng = .Range("A1:X37")
                Set cel = .Range("X37")
            Case Is <= 10
                Set rng = .Range("A1:X45")
                Set cel = .Range("X45")
            Case Is <= 15
                Set rng = .Range("A1:X53")
                Set cel = .Range("X53")
            Case Is <= 20
                Set rng = .Range("A1:X61")
                Set cel = .Range("X61")
        End Select
[I][COLOR=#006400]'if one of the values met the criteria then copy the correct range[/COLOR][/I]
        If Not rng Is Nothing Then rng.Copy Destination:=cel
    End With
End Sub

 

[Yongle]

Re: VBA Code Help - Copying Range Based on Cell Value

You could also test this to see if it does what you want...

Sub copyreport4()
    Dim r As Long
    With ActiveSheet
        Select Case .Range("W25")
            Case Is <= 5:   r = 37
            Case Is <= 10:  r = 45
            Case Is <= 15:  r = 53
            Case Is <= 20:  r = 61
        End Select
[I][COLOR=#006400]'if one of the values met the criteria then copy the correct range[/COLOR][/I]
        If  r <> 0 Then .Range("A1").Resize(r).Copy Destination:=.Range("X1").Offset(r - 1)
    End With
End Sub

For info ...

    Range("A1:A5").Copy Destination:= Range("X5")

can also be writtten without specifying Destination:=
like this:

    Range("A1:A5").Copy Range("X5")