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:
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 = nextCellVal 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: Excel VBA Macro: Sorting with Groups or Bound Rows
Let me know your thoughts...