Read column B and turn it into header rows

[jmmac]

I have a sheet similar to the following. Each section changes in length daily, so I need to be able to have my macro read this dynamically.

Name Rank
John Smith First
Angela Simms First
Mike Dunn First
Paul Nabors First
Tim Evans Second
Frank White Second
Gina Crow Second
Laura Wild Third
George Amos Third
Amy Jackson Third
James Shelton Third

I have up to 12 rankings, and each one can contain any number of entries daily. I'd like the macro to output something like:

First
John Smith
Angela Simms
Mike Dunn
Paul Nabors
Second
Tim Evans
Frank White
Gina Crow
Third
Laura Wild
George Amos
Amy Jackson
James Shelton

I should note that there are other columns of data to be transferred with each person. I can move the Rank column to column A if need be.

 

[ttdk1]

Assuming the names and rank are in same cell and the list runs down A column, starting from A2. The list is in Sheet1. BUT, if the list is in two columns where the rank is in column B, then remove the bolded section.

The second part, displayed by the macro, will run down column D, starting at D1

Sub Sample()
Dim LastRow, currRow As Integer
Dim ListArr, WrdArr, Wrd As Variant
Dim Heading, currHeading As String


  LastRow = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
  ListArr = Worksheets("Sheet1").Range("A2:B" & LastRow).Value
[B]  For i = 1 To LastRow - 1
    WrdArr = Split(ListArr(i, 1), " ")
    j = 0
    For Each Wrd In WrdArr
      j = j + 1
      ListArr(i, Int(j / 3) + 1) = Choose(j, Wrd, ListArr(i, Int(j / 3) + 1) & " " & Wrd, Wrd)
    Next Wrd
  Next i[/B]
  currRow = 1
  currHeading = ""
  For x = 1 To 12
    Heading = Choose(x, "First", "Second", "Third", "Fourth", "Fifth", "Sixth", "Seventh", "Eighth", "Nineth", "Tenth", "Eleventh", "Twelveth")
    For y = 1 To LastRow - 1
      If ListArr(y, 2) = Heading Then
        If currHeading <> Heading Then
          If currRow > 1 Then currRow = currRow + 1
          Worksheets("Sheet1").Range("D" & CStr(currRow)).Value = Heading
          currHeading = Heading
          currRow = currRow + 1
        End If
        Worksheets("Sheet1").Range("D" & CStr(currRow)).Value = ListArr(y, 1)
        currRow = currRow + 1
      End If
    Next y
  Next x
End Sub

 

[ztodd]

Try figuring out some code yourself and I bet you can come with something simpler than what ttdk1 posted. I'm sure I could.

 

[jmmac]

I'm sure you could too, which is exactly why I posted here - because I can't figure it out. I have a very basic understanding of VBA. I can copy and paste, bold, etc. What I can't figure out is how to make it read down the rank column, recognize like values, turn them into a header row, and copy all cells that apply, then move to the next value.

 

[tusharm]

If you must have the rank in a separate row, you will have to use code. While I can do amazing things with code it remains a "last resort" given the cost/problems with development, testing, security, and maintainability.

In this case, I would use conditional formatting on the column containing the rank. If the cell value is different from the value in the cell above it, make that cell bold.

I have a sheet similar to the following. Each section changes in length daily, so I need to be able to have my macro read this dynamically.

Name Rank
John Smith First
Angela Simms First
Mike Dunn First
Paul Nabors First
Tim Evans Second
Frank White Second
Gina Crow Second
Laura Wild Third
George Amos Third
Amy Jackson Third
James Shelton Third

I have up to 12 rankings, and each one can contain any number of entries daily. I'd like the macro to output something like:

First
John Smith
Angela Simms
Mike Dunn
Paul Nabors
Second
Tim Evans
Frank White
Gina Crow
Third
Laura Wild
George Amos
Amy Jackson
James Shelton

I should note that there are other columns of data to be transferred with each person. I can move the Rank column to column A if need be.

 

[jmmac]

Here's a link to my file as I have it so far:
https://app.box.com/s/s6lld61ytqb2gltc63kd

Any help is appreciated

 

[ztodd]

I'm sure you could too, which is exactly why I posted here - because I can't figure it out. I have a very basic understanding of VBA. I can copy and paste, bold, etc. What I can't figure out is how to make it read down the rank column, recognize like values, turn them into a header row, and copy all cells that apply, then move to the next value.

Did you take any of my suggestions in my last post? Are you opposed to researching and trying out some VBA on your own?
edit:
sorry, maybe I spoke too soon- I just saw your last post.

 

[jmmac]

If I can get the filter feature to work, I can figure out the rest (bold "ranks" as header rows, etc.)

 

[ztodd]

Looked at your code- you don't need a nested loop (for loop inside a for loop)- you only need one loop. Here- break it down into simple steps written in English first- like this-

1. Start a loop through the rows on Sheet 1, starting with row 2
2. Look at current row, column A- is it different than previous row, column A?
   1. If Yes, then copy current row, column A to next available row in Sheet 2, column A, and make it bold. (Use a variable to keep track of this next available row)
3. Copy current row, column B through whatever your last column is that you want to copy, over to the next available row on sheet 2.
4. If not at last row yet on Sheet 1, advance to next row and continue loop with step 2.

Does this sound simple enough? I would do the loop like this -

set r = range("A2")
do
  ' your code to compare and copy
  set r = r.offset(1)     ' to advance to next row.
loop until r.value = ""

Try to keep it simple like this. Know what all the commands do before you use them.

 

[ttdk1]

here's another one with comments to explain what each does. There's a lot of redundancy but easier to grasp. There's only one loop,

Sub processList()

  
  '////////////////////////////////////////////////////////////////////////////
  'define constants, change them as you see fit
  nameColumn = "A"
  rankColumn = "B"
  outputColumn = "D"
  
  'starting row of the list if names and ranks
  inputRow = 2
  
  'starting row for the destination list
  outputRow = 1

  '///////////////////////////////////////////////////////////////////////////
  
  'initial rank values are empty
  currentRank = ""
  newRank = ""
    
  'boolean to check for when you hit the end of the list of names and ranks
  lastRow = False
  
  'start loop and continue until lastRow is TRUE
  Do While lastRow = False
  
    'trieve the rank value
    newRank = Range(rankColumn & inputRow).Value
    
    'is the retrieved rank value a first occurance?
    If newRank <> currentRank Then
      
      'add a blank row before rank header
      outputRow = outputRow + 1
      
      'copy rank value to destination list
      Range(outputColumn & outputRow).Value = newRank
      
      'increment the destination row counter now that you just added a value
      outputRow = outputRow + 1
    
      'update currentRank to reflect retrieved value
      currentRank = newRank
    End If
    
    'copy name from input list to destination list
    Range(outputColumn & outputRow).Value = Range(nameColumn & inputRow).Value
    
    'since you added a value to destination list, increment the row counter
    outputRow = outputRow + 1
    
    'retrieve the next name in the input list.  offset(1,0) just means one row down
    nextRow = Range(nameColumn & inputRow).Offset(1, 0).Value
    
    'is the retrieved name not empty?  if yes, then ...
    If nextRow <> "" Then
      
      'increment the input row counter
      inputRow = inputRow + 1
    
    'if not, then ...
    Else
      
      'make lastRow = TRUE, which terminates the loop
      lastRow = True
    End If
    
  Loop
  
End Sub