|
VBA Help
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 |
VBA Help
|
VBA Help
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 -- Don Guillett Microsoft MVP Excel SalesAid Software "terilad" wrote in message ... Hi Don, I have sent you the file and instructions. Many thanks Mark "Don Guillett" wrote: 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. -- Don Guillett Microsoft MVP Excel SalesAid Software "terilad" wrote in message ... 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 |
| All times are GMT +1. The time now is 02:10 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com