Searching Worksheet for Similar Rows to Group Together Excel VBA
I have a worksheet with headers listed in the top row. I also have data listed in rows below. This data is to remain grouped together as a row, and cannot change position relative to one another. However, the entire row can move freely. Each header describes a data type of the row below.
I want to be able to:
- Tell the macro in what column to look to group rows. For ease, we'll call this Col D
- Look through entire worksheet.
- Move similar rows so they are grouped together.***
- Add group to a selection
*Note I will also be marking groups with an integer in column Z to show the group is a group
The problem I am having is with the following line of my sub FindRow:
ActiveSheet.Range(curRange).Resize (resizeRng)
Dubug says curRange = "Elevator" which is the value of a cell, but not a range, yet I define it up above:
inRange = "A" & rngStart & ":" & Mid(alphabet, totHdrLngth, 1) & belowRowCount
Set curRange = ActiveSheet.Range(inRange)
For reference I explain the overall code below:
CreateGroup - checks if subsequent rows have the same value in Col D. If so it marks this group as a unique integer, and increases selection. If not FindRow is called.
FindRow - searches the entire worksheet for row (row1) having same value in Col D. If found, calls rowSwapper to swap the found row (row2) with the row below row1.
RowSwapper - function takes in two row numbers, and swaps them.
Here's the sub CreateGroup:
Public Sub CreatGroup()
Dim letterCount As Integer
Dim letString, label, inRange As String
Dim rowSelect, marker, rowStart, rowCount, rngStart, count As Long
'Predefine necessary variables
marker = 1
rowCount = 2 'Start at row 2, excluding header
rowStart = 2 'For range reference to create group
belowRowCount = 3 'start below rowCount
isGroup = False
count = 1
'Loop through each cell in column D to determine if consecutive metrics have the same value
'If true, while loop sorts each series of consecutive metrics individually
Do
curCellVal = ActiveSheet.Range("D" & rowCount).Value 'Returns value rowCount(th) row of "Metric" column
nextCellVal = ActiveSheet.Range("D" & belowRowCount).Value 'Returns the value of the row under rowCount
marker = 1
resizeRng = 0
'Makes a cell selection while cell values in column 4 are equal
If curCellVal = nex开发者_StackOverflow社区tCellVal Then '<<<NECESSARY?
isGroup = True 'Designates group has been found
If resizeRng = 0 Then
rngStart = rowCount
End If
'rowStart = ActiveSheet.Row
'Resize selection to include cell with same metric name
inRange = "A" & rngStart & ":" & Mid(alphabet, totHdrLngth, 1) & belowRowCount
Set curRange = ActiveSheet.Range(inRange)
'Establish place holder in col "Z" (empty) to track groups
ActiveSheet.Range("Z" & rowCount).Value = marker
ActiveSheet.Range("Z" & belowRowCount).Value = marker
resizeRng = resizeRng + 1
rowCount = rowCount + resizeRng
belowRowCount = rowCount + 1
ElseIf curCellVal <> nextCellVal Then 'And isGroup = True Then
FindRow rowCount
'Re-establish rowCount to account for cells that may have been added to group
rowCount = rowCount + resizeRng
belowRowCount = rowCount + 1
Else
rowCount = rowCount + 1
belowRowCount = rowCount + 1
End If
'to prevent subsequent groups of metrics from being labeled together
marker = marker + 1
isGroup = False
Loop While rowCount <= totCount
End Sub
Also, for additional reference, these subs are part of a larger program described here: Sorting Groups of Rows Excel VBA Macro
Let me know your thoughts...
If you want to get the cell range address, you just need to say rng.Address. Just specifying that you want rng is the same (essentially) as saying rng.Value
As for the line:
ActiveSheet.Range(curRange).Resize (resizeRng)
You may want to try
ActiveSheet.Range(curRange).Cells.Resize (resizeRng)
I was playing around with some formatting last night on a little project of my own and ran into a similar error.
Hope that helps.
精彩评论