VBA Help

[terilad]

Hi,

I have the following macro to rotate a shift pattern on a click of a cell.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
As Range)
If Target.Address = Range("S2").Address Then
If MsgBox("Do you want to rotate shift", vbYesNo + vbInformation, "Kelso
Operational Resources © MN ") <> _
vbYes Then Exit Sub
Dim lngRow As Long
Dim intTemp As Integer
Dim arrData(16) As Variant
Range("N2") = Range("N2") + 7
Range("D4") = Range("D4") + 7
Range("F4") = Range("F4") + 7
Range("H4") = Range("H4") + 7
Range("J4") = Range("J4") + 7
Range("L4") = Range("L4") + 7
Range("N4") = Range("N4") + 7
Range("P4") = Range("P4") + 7
arrData(0) = Range("C35")
For lngRow = 5 To 35 Step 2
intTemp = intTemp + 1
arrData(intTemp) = Range("C" & lngRow)
Range("C" & lngRow) = arrData(intTemp - 1)
Next
Range("C1") = varValue
Range("D6:Q6").ClearContents
Range("D8:Q8").ClearContents
Range("D10:Q10").ClearContents
Range("D12:Q12").ClearContents
Range("D14:Q14").ClearContents
Range("D16:Q16").ClearContents
Range("D18:Q18").ClearContents
Range("D20:Q20").ClearContents
Range("D22:Q22").ClearContents
Range("D24:Q24").ClearContents
Range("D26:Q26").ClearContents
Range("D28:Q28").ClearContents
Range("D30:Q30").ClearContents
Range("D32:Q32").ClearContents
Range("D34:Q34").ClearContents
Range("D36:Q36").ClearContents
Range("B44:Q44").ClearContents
Range("D6:Q6").Interior.ColorIndex = xlNone
Range("D8:Q8").Interior.ColorIndex = xlNone
Range("D10:Q10").Interior.ColorIndex = xlNone
Range("D12:Q12").Interior.ColorIndex = xlNone
Range("D14:Q14").Interior.ColorIndex = xlNone
Range("D16:Q16").Interior.ColorIndex = xlNone
Range("D18:Q18").Interior.ColorIndex = xlNone
Range("D20:Q20").Interior.ColorIndex = xlNone
Range("D22:Q22").Interior.ColorIndex = xlNone
Range("D24:Q24").Interior.ColorIndex = xlNone
Range("D26:Q26").Interior.ColorIndex = xlNone
Range("D28:Q28").Interior.ColorIndex = xlNone
Range("D30:Q30").Interior.ColorIndex = xlNone
Range("D32:Q32").Interior.ColorIndex = xlNone
Range("D34:Q34").Interior.ColorIndex = xlNone
Range("D36:Q36").Interior.ColorIndex = xlNone
Range("B44:Q44").Interior.ColorIndex = xlNone
End If
End Sub

What I am needing to do is split the rotation so that For ingrow = 5 to 35
step 2
is 5 to 19 step 2 and I need to add that 21 to 35 step 2

the arrdata range C19 on ingrow 5 to 19 and arrdata range is C35 on ingrow
21 to 35.

Can anyone help me on splitting this macro to rotate celles top half and
bottom half.

Regards


Mark

 

[Don Guillett]

If desired, send your file to my address below along with this msg and
a clear explanation of what you want and before/after examples.

 

[terilad]

Hi Don,

I have sent you the file and instructions.

Many thanks

Mark

 

[Don Guillett]

Sub DoRotationSAS() 'SalesAidSoftware
'Assigned to shape on sheet
Dim i As Long
Dim lg
If MsgBox("Do you want to rotate shift", vbYesNo + vbInformation, _
"Kelso Operational Resources © MN ") <> _
vbYes Then Exit Sub
Range("N2") = Range("N2") + 7
'others done by FORMULA
lg = Range("c19")
Range("c5:c17").Cut Range("c7")
Range("c5") = lg

lg = Range("c35")
Range("c21:c33").Cut Range("c23")
Range("c21") = lg

Range("c7").Copy
Range("c5,c21").PasteSpecial Paste:=xlPasteFormats
Range("c5").Select
'=========clear ranges
For i = 6 To 36 Step 2
With Range(Cells(i, "d"), Cells(i, "q"))
.ClearContents
.Interior.ColorIndex = xlNone
End With
Next i

With Range("B44:Q44")
.ClearContents
.Interior.ColorIndex = xlNone
End With

End Sub