View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Trouble cutting a range of cells

You are probably having problems with the lines wrapping. when code is
posted after 80 characters this website adds a new line but doesn't add the
continuation character (_) to the end of the lines. You have to manually fix
these problems like I did below. the code doesn't run for me because pGroups
is not defined.

Sub OrderBySubtotal()

Dim iBegin As Integer
Dim iEnd As Integer
Dim x As Integer
Dim y As Integer
Dim rSelection As Integer
Dim iTempRow As Integer
Dim sTempGroup As String
Dim iTempTotal As Integer

iBegin = LBound(pGroups) + 1
iEnd = UBound(pGroups)

For x = iBegin To iEnd - 1
For y = iBegin + 1 To iEnd
If pGroups(x, 2) < pGroups(y, 2) Then
'Getting error here
pWorksheet.Range(Cells(pGroups(y, 0), 1), _
Cells(pGroups(y, 0) + pGroups(y, 2)), 10).Cut
pWorksheet.Range(Cells(pGroups(x, 0), 1)).Insert _
Shift:=xlDown
iTempRow = pWorksheet(y, 0)
sTempGroup = pWorksheet(y, 1)
iTempTotal = pWorksheet(y, 2)
pGroups(y, 0) = pWorksheet(x, 0)
pGroups(y, 1) = pWorksheet(x, 1)
pGroups(y, 2) = pWorksheet(x, 2)
pWorksheet(x, 0) = Int(iTempRow) + _
Int(pWorksheet(y, 0)) + 1
pWorksheet(x, 1) = sTempGroup
pWorksheet(x, 2) = iTempTotal
End If
Next y
Next x
End Sub


"Gary Keramidas" wrote:

this compiles for me, but i couldn't run it.

Sub OrderBySubtotal()

Dim iBegin As Integer
Dim iEnd As Integer
Dim x As Integer
Dim y As Integer
Dim rSelection As Integer
Dim iTempRow As Integer
Dim sTempGroup As String
Dim iTempTotal As Integer

iBegin = LBound(pGroups) + 1
iEnd = UBound(pGroups)

For x = iBegin To iEnd - 1
For y = iBegin + 1 To iEnd
If pGroups(x, 2) < pGroups(y, 2) Then
'Getting error here
pWorksheet.Range(Cells(pGroups(y, 0), 1), Cells(pGroups(y, _
0) + pGroups(y, 2)), 10).Cut
pWorksheet.Range(Cells(pGroups(x, 0), 1)).Insert , _
Shift:=xlDown
iTempRow = pWorksheet(y, 0)
sTempGroup = pWorksheet(y, 1)
iTempTotal = pWorksheet(y, 2)
pGroups(y, 0) = pWorksheet(x, 0)
pGroups(y, 1) = pWorksheet(x, 1)
pGroups(y, 2) = pWorksheet(x, 2)
pWorksheet(x, 0) = Int(iTempRow) + Int(pWorksheet(y, 0)) + 1
pWorksheet(x, 1) = sTempGroup
pWorksheet(x, 2) = iTempTotal
End If
Next y
Next x
End Sub


--


Gary


"Tim" wrote in message
...
When running the below sub, I am receiving the following error:
Compile error:
Wrong number of arguments or invalid property assignment

I am trying to move a range of cells in order by a subtotal, which could vary.
To move the cells, I am trying to do a cut and insert before swapping the
array elements.
pGroup(x,0) = cell row of group
pGroup(x,1) = string value of no importance for this exercise
pGroup(x,2) = Subtotal (number of entries(rows) within the group)

Once the cells are moved, the Array Elements will be swapped.
With the exception of the cell row, which will be recalculated for x.

Any help will be greatly appreciated.

Sub OrderBySubtotal()

Dim iBegin As Integer
Dim iEnd As Integer
Dim x As Integer
Dim y As Integer
Dim rSelection As Integer
Dim iTempRow As Integer
Dim sTempGroup As String
Dim iTempTotal As Integer

iBegin = LBound(pGroups) + 1
iEnd = UBound(pGroups)

For x = iBegin To iEnd - 1
For y = iBegin + 1 To iEnd
If pGroups(x, 2) < pGroups(y, 2) Then
'Getting error here
pWorksheet.Range(Cells(pGroups(y, 0), 1),
Cells(pGroups(y, 0) + pGroups(y, 2)), 10).Cut
pWorksheet.Range(Cells(pGroups(x, 0), 1)).Insert
Shift:=xlDown
iTempRow = pWorksheet(y, 0)
sTempGroup = pWorksheet(y, 1)
iTempTotal = pWorksheet(y, 2)
pGroups(y, 0) = pWorksheet(x, 0)
pGroups(y, 1) = pWorksheet(x, 1)
pGroups(y, 2) = pWorksheet(x, 2)
pWorksheet(x, 0) = Int(iTempRow) + Int(pWorksheet(y, 0))
+ 1
pWorksheet(x, 1) = sTempGroup
pWorksheet(x, 2) = iTempTotal
End If
Next y
Next x
End Sub