VBA help needed

[asad]

Hello All,

I am trying to change my VBA codes to make more user friendly by giving the users ability to determine the start and finish of the ranges. The code that is already working is like this:

Sub Test()                    
                   Worksheets("Express").Activate
                 
                           Range("E3") = Range("K3").Value + 1
                           
                            [B14:B29] = [B13:B28].Value
                            [B13] = [B29].Value
                            [B29].ClearContents
                            
                            [B32:B37] = [B31:B36].Value
                            [B31] = [B37].Value
                            [B37].ClearContents
                            
                            [B40:B52] = [B39:B51].Value
                            [B39] = [B52].Value
                            [B52].ClearContents
                            


End Sub

The above code worked alright but they wanted to be able to determine the ranges to be rotated. So I created another sheet where they can type in the row references that need to be rotated. The range looks like this :

[TABLE="width: 397"]
<colgroup><col><col><col span="2"></colgroup><tbody>[TR]
[TD]Department/Sheet Name[/TD]
[TD]Rotation Group[/TD]
[TD]Start Row[/TD]
[TD]End Row[/TD]
[/TR]
[TR]
[TD]Express[/TD]
[TD]AM[/TD]
[TD="align: right"]13[/TD]
[TD="align: right"]28[/TD]
[/TR]
[TR]
[TD]Express[/TD]
[TD]Middle[/TD]
[TD="align: right"]31[/TD]
[TD="align: right"]36[/TD]
[/TR]
[TR]
[TD]Express[/TD]
[TD]PM[/TD]
[TD="align: right"]39[/TD]
[TD="align: right"]51[/TD]
[/TR]
[TR]
[TD]CSO[/TD]
[TD]TL[/TD]
[TD="align: right"]13[/TD]
[TD="align: right"]17[/TD]
[/TR]
[TR]
[TD]CSO[/TD]
[TD]PFT[/TD]
[TD="align: right"]20[/TD]
[TD="align: right"]32[/TD]
[/TR]
[TR]
[TD]CSO[/TD]
[TD]PT[/TD]
[TD="align: right"]46[/TD]
[TD="align: right"]47[/TD]
[/TR]
</tbody>[/TABLE]

And then I tried the following VBA code:

Sub Test()Dim rng As Range, c As Range


    
     Set rng = Sheets("Master").Range("O2:O32")


             
                     
                  Worksheets("Express").Activate
                    With Worksheets("Express")
                           
                            For Each c In rng
                                If c.Value = "Express" Then
                                    Range("B" & c.Offset(, 2).Value + 1 & ":B" & c.Offset(, 3).Value + 1) = Range("B" & c.Offset(, 2).Value & ":B" & c.Offset(, 3).Value)
                                    Range("B" & c.Offset(, 2).Value) = Range("B" & c.Offset(, 2).Value + 1)
                                    Range("B" & c.Offset(, 2).Value + 1).ClearContents
                                    
                                End If
                            Next c
                    End With


End Sub

This doesn't do anything at all. Why would that be? Is it because the "rng" has been defined in some other sheet or because of some other reason?

Any help to put me on the right path to solve this would be greatly appreciated.

Thanks
Asad

 

[asad]

One mistake that I picked up while reading through the code was that I had typed in the wrong range. It should be M2:M32 instead of O2:O32.
But, again it did not work as i intended. This time it deleted all values.

 

[asad]

Now I have changed the VBA again to this:

Sub Test()Dim rng As Range, c As Range


    
     Set rng = Sheets("Master").Range("M2:M32")
                  
           For Each c In rng
             If c.Value <> " " Then
               ThisWorkbook.Worksheets(c.Value).Range("B" & c.Offset(, 2).Value + 1 & ":B" & c.Offset(, 3).Value + 1) = ThisWorkbook.Worksheets(c.Value).Range("B" & c.Offset(, 2).Value & ":B" & c.Offset(, 3).Value)
               ThisWorkbook.Worksheets(c.Value).Range("B" & c.Offset(, 2).Value) = ThisWorkbook.Worksheets(c.Value).Range("B" & c.Offset(, 2).Value + 1)
               ThisWorkbook.Worksheets(c.Value).Range("B" & c.Offset(, 2).Value + 1).ClearContents
                                    
             End If
           Next c


End Sub

But it is deleting all the values in the correct ranges though. So it does go to the correct ranges, but instead of moving the values one cell down, it is deleting all the values.
Utterly confused.

 

[asad]

Ah, finally worked it out. Here is the working code, just in case someone wants it.

Sub Test()Dim rng As Range, c As Range


    
     Set rng = Sheets("Master").Range("M2:M32")
                  
           For Each c In rng
             If c.Value <> "" Then
               ThisWorkbook.Worksheets(c.Value).Range("B" & c.Offset(, 2).Value & ":B" & c.Offset(, 3).Value).Copy ThisWorkbook.Worksheets(c.Value).Range("B" & c.Offset(, 2).Value + 1 & ":B" & c.Offset(, 3).Value + 1)
               ThisWorkbook.Worksheets(c.Value).Range("B" & c.Offset(, 3).Value + 1).Copy ThisWorkbook.Worksheets(c.Value).Range("B" & c.Offset(, 2).Value)
               ThisWorkbook.Worksheets(c.Value).Range("B" & c.Offset(, 3).Value + 1).ClearContents
                                    
             End If
           Next c


End Sub