Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Trouble cutting a range of cells
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
Tim Tim is offline
external usenet poster
  
Posts: 408
Default Trouble cutting a range of cells
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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 2,494
Default Trouble cutting a range of cells
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


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
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



Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
Tim Tim is offline
external usenet poster
  
Posts: 408
Default Trouble cutting a range of cells

Joel, Here is the whole Code:
<<<<Module
Sub FormatQtrAnalysis()

Dim csaQtrAnalysis As CSTIAnalysis
Set csaQtrAnalysis = New CSTIAnalysis

csaQtrAnalysis.Worksheet = ActiveSheet
csaQtrAnalysis.FormatHeader
csaQtrAnalysis.SortGroups

End Sub
<<<CSTIAnalysis Class
Private pWorksheet As Worksheet
Private pGroups() As String
'
Public Property Get Worksheet() As Worksheet
Worksheet = pWorksheet
End Property
Public Property Let Worksheet(vNewValue As Worksheet)
Set pWorksheet = vNewValue
End Property
'
Public Sub FormatHeader()
Dim rHeader As Range
Dim iColCount As Integer

iColCount = pWorksheet.UsedRange.Columns.Count
Set rHeader = pWorksheet.Range(Cells(1, 1), Cells(1, iColCount))
rHeader.MergeCells = False
With rHeader
.Merge 'Merge all cells with range
.EntireRow.AutoFit 'Fit Row to font height
.BorderAround Weight:=xlThick, ColorIndex:=1 'Continous Thick Black
Border
End With

End Sub
'
Public Sub SortGroups()

CreateGroups
OrderBySubtotal

End Sub
'
Function CreateGroups()
Dim iNumOfRows As Integer
Dim x As Integer
Dim y As Integer
Dim iNumOfGroups As Integer
Const sGroupFlag As String = "Sub Total"

iNumOfRows = pWorksheet.UsedRange.Rows.Count
x = 0
y = 1
iNumOfGroups = NumOfGroups()
ReDim pGroups(0 To iNumOfGroups, 0 To 2)
Do Until pWorksheet.Cells((1 + x), 9).Row = iNumOfRows
If Left(pWorksheet.Cells((1 + x), 9).Value, Len(sGroupFlag)) =
sGroupFlag Then
pGroups(y, 0) = pWorksheet.Cells((1 + x), 9).Row
pGroups(y, 1) = Trim(Replace(pWorksheet.Cells((1 + x),
9).Offset(0, -8).Value, Chr(160), vbNullString))
pGroups(y, 2) = Int(Mid(pWorksheet.Cells((1 + x), 9),
(Len(sGroupFlag) + 2)))
y = y + 1
End If
x = x + 1
Loop
End Function
'
Sub OrderBySubtotal()

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


iBegin = LBound(pGroups) + 1
Debug.Print iBegin
iEnd = UBound(pGroups)

For x = iBegin To iEnd - 1
For y = iBegin + 1 To iEnd
If pGroups(x, 2) < pGroups(y, 2) Then
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
'
Public Function NumOfGroups() As Integer

Dim iNumOfRows As Integer
Dim x As Integer
Dim iNumOfGroups As Integer
Const sGroupFlag As String = "Sub Total"
Const sEndFlag As String = "Brief Desc."

iNumOfRows = pWorksheet.UsedRange.Rows.Count
x = 1
iNumOfGroups = 0

Do Until Cells((iNumOfRows - x), 9).Value = sEndFlag
If Left(Cells((iNumOfRows - x), 9).Value, Len(sGroupFlag)) =
sGroupFlag Then
iNumOfGroups = iNumOfGroups + 1
End If
x = x + 1
Loop

NumOfGroups = iNumOfGroups
End Function

"Joel" wrote:

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



Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 9,101
Default Trouble cutting a range of cells

I don't think Pgroups has any data. I would add a few debug statements

iBegin = LBound(pGroups) + 1
Debug.Print iBegin
iEnd = UBound(pGroups)
Debug.Print iEnd


I think the problem is here
Function CreateGroups()
Dim iNumOfRows As Integer
Dim x As Integer
Dim y As Integer
Dim iNumOfGroups As Integer
Const sGroupFlag As String = "Sub Total"

iNumOfRows = pWorksheet.UsedRange.Rows.Count
x = 0
y = 1
iNumOfGroups = NumOfGroups() '<==========This may
be the problem
ReDim pGroups(0 To iNumOfGroups, 0 To 2)

from
iNumOfGroups = NumOfGroups()
to
iNumOfGroups = Ubound(NumOfGroups)
debug iNumOfGroups

"Tim" wrote:


Joel, Here is the whole Code:
<<<<Module
Sub FormatQtrAnalysis()

Dim csaQtrAnalysis As CSTIAnalysis
Set csaQtrAnalysis = New CSTIAnalysis

csaQtrAnalysis.Worksheet = ActiveSheet
csaQtrAnalysis.FormatHeader
csaQtrAnalysis.SortGroups

End Sub
<<<CSTIAnalysis Class
Private pWorksheet As Worksheet
Private pGroups() As String
'
Public Property Get Worksheet() As Worksheet
Worksheet = pWorksheet
End Property
Public Property Let Worksheet(vNewValue As Worksheet)
Set pWorksheet = vNewValue
End Property
'
Public Sub FormatHeader()
Dim rHeader As Range
Dim iColCount As Integer

iColCount = pWorksheet.UsedRange.Columns.Count
Set rHeader = pWorksheet.Range(Cells(1, 1), Cells(1, iColCount))
rHeader.MergeCells = False
With rHeader
.Merge 'Merge all cells with range
.EntireRow.AutoFit 'Fit Row to font height
.BorderAround Weight:=xlThick, ColorIndex:=1 'Continous Thick Black
Border
End With

End Sub
'
Public Sub SortGroups()

CreateGroups
OrderBySubtotal

End Sub
'
Function CreateGroups()
Dim iNumOfRows As Integer
Dim x As Integer
Dim y As Integer
Dim iNumOfGroups As Integer
Const sGroupFlag As String = "Sub Total"

iNumOfRows = pWorksheet.UsedRange.Rows.Count
x = 0
y = 1
iNumOfGroups = NumOfGroups()
ReDim pGroups(0 To iNumOfGroups, 0 To 2)
Do Until pWorksheet.Cells((1 + x), 9).Row = iNumOfRows
If Left(pWorksheet.Cells((1 + x), 9).Value, Len(sGroupFlag)) =
sGroupFlag Then
pGroups(y, 0) = pWorksheet.Cells((1 + x), 9).Row
pGroups(y, 1) = Trim(Replace(pWorksheet.Cells((1 + x),
9).Offset(0, -8).Value, Chr(160), vbNullString))
pGroups(y, 2) = Int(Mid(pWorksheet.Cells((1 + x), 9),
(Len(sGroupFlag) + 2)))
y = y + 1
End If
x = x + 1
Loop
End Function
'
Sub OrderBySubtotal()

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


iBegin = LBound(pGroups) + 1
Debug.Print iBegin
iEnd = UBound(pGroups)

For x = iBegin To iEnd - 1
For y = iBegin + 1 To iEnd
If pGroups(x, 2) < pGroups(y, 2) Then
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
'
Public Function NumOfGroups() As Integer

Dim iNumOfRows As Integer
Dim x As Integer
Dim iNumOfGroups As Integer
Const sGroupFlag As String = "Sub Total"
Const sEndFlag As String = "Brief Desc."

iNumOfRows = pWorksheet.UsedRange.Rows.Count
x = 1
iNumOfGroups = 0

Do Until Cells((iNumOfRows - x), 9).Value = sEndFlag
If Left(Cells((iNumOfRows - x), 9).Value, Len(sGroupFlag)) =
sGroupFlag Then
iNumOfGroups = iNumOfGroups + 1
End If
x = x + 1
Loop

NumOfGroups = iNumOfGroups
End Function

"Joel" wrote:

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



Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
Tim Tim is offline
external usenet poster
  
Posts: 408
Default Trouble cutting a range of cells
Thanks for the help, I figured it out.
I have to make a selection prior to Cutting and Pasting.

"Tim" wrote:

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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
trouble with lookup in a range of cells. evilthorne Excel Worksheet Functions 5 September 28th 09 02:16 AM
Cutting and Pasting Cells into a shape or textbox Gator Excel Discussion (Misc queries) 4 July 14th 08 08:21 PM
How do I freeze formulas when cutting and pasting other cells? thunderstix33 Excel Worksheet Functions 1 June 3rd 08 06:57 PM
Selecting and cutting unknown picture numbers from a specifc range of cells [email protected] Excel Programming 3 October 29th 07 09:09 PM
Protection, cutting cells Bryce Excel Discussion (Misc queries) 0 February 26th 07 03:11 AM


All times are GMT +1. The time now is 09:32 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement