group rows in a range based on criteria from another range (vba)

[Andy]

I'm trying to get VBA code to check code numbers (all cells in text format to
keep the initial 0) and then print a header followed by the matching items. The
item descriptions do not need manipulation. I've written some code with
debug.print output that is close to what I need, but I'm not sure how to get the
output to sheet3 and include the item descriptions. Below is the code and
output, followed by the output required and some sample data. Any help greatly
appreciated.

Sub GettingCloser()
Dim MyCodesArray As Integer
Sheet2.Range("A2:A11").Name = "MyCodesArray"
Sheet2.Range("E2:E6").Name = "MyGroupsArray"
For Each groupcell In Range("MyGroupsArray")
Debug.Print "Group "; groupcell; " items"
For Each codecell In Range("MyCodesArray")
If Left(codecell, 3) = groupcell Then
Debug.Print codecell
End If
Next codecell
Next groupcell
End Sub

Group 010 items
01050
Group 013 items
01315
Group 025 items
02530
02550
Group 033 items
03360
03370
03390
Group 042 items
04200
04220
04260

The output I need to end up with is as follows and below that is some sample data
I'm working with.:

Sheet3
Group 010 Items
01050 item 01050

Group 013 Items
01315 item 01315

Group 025 Items
02530 item 02530
02550 item 02550

Group 033 Items
03360 item 03360
03370 item 03370
03390 item 03390

Group 042 Items
04200 item 04200
04220 item 04220
04260 item 04260

-- Sample Data --
Sheet2.Range("A2:A11").Name = "MyCodesArray"
Code Description
01050 item 01050
01315 item 01315
02530 item 02530
02550 item 02550
03360 item 03360
03370 item 03370
03390 item 03390
04200 item 04200
04220 item 04220
04260 item 04260

Sheet2.Range("E2:E6").Name = "MyGroupsArray"
Group
010
013
025
033
042

 

[Andy]

Made some modifications to the code and I'm closer, but need some help on getting
the right description cell to sheet3. Below is the new code and resulting
output:

Sub GettingCloser()
Sheet2.Range("A2:B10").Name = "MyCodesArray"
Sheet2.Range("E2:E6").Name = "MyGroupsArray"
For Each groupcell In Range("MyGroupsArray")
Sheets("Sheet3").Range("A1").Offset(iCol, 0) = "Group " & groupcell & "
items"
iCol = iCol + 1
For Each codecell In Range("MyCodesArray")
desccell = Range("MyCodesArray").Cells(1, 2)
If Left(codecell, 3) = groupcell Then
Sheets("Sheet3").Range("A1").Offset(iCol, 0) = codecell
Sheets("Sheet3").Range("A1").Offset(iCol, 1) = desccell
iCol = iCol + 1
End If
Next codecell
iCol = iCol + 1
Next groupcell
End Sub

Group 010 items
01050 item 01050

Group 013 items
01315 item 01050

Group 025 items
02530 item 01050
02550 item 01050

Group 033 items
03360 item 01050
03370 item 01050
03390 item 01050

Group 042 items
04200 item 01050
04220 item 01050

 

[Andy]

Code below works. Just to end the thread.


Option Explicit
Sub Fair()
Dim Drow, iCol As Integer
Dim groupcell, codecell As Object

Sheet2.Range("A2:B90").Name = "MyCodesArray"
Sheet2.Range("G2:G43").Name = "MyGroupsArray"
Drow = 1

For Each groupcell In Range("MyGroupsArray")
Sheets("Sheet3").Range("A1").Offset(iCol, 0) = "Group " & groupcell &
"items "
iCol = iCol + 1
For Each codecell In Range("MyCodesArray")
If Left(codecell, 3) = groupcell Then
Sheets("Sheet3").Range("A1").Offset(iCol, 0) =
Range("MyCodesArray").Cells(Drow, 1)
Sheets("Sheet3").Range("A1").Offset(iCol, 1) =
Range("MyCodesArray").Cells(Drow, 2)
Drow = Drow + 1
iCol = iCol + 1
End If
Next codecell
iCol = iCol + 1
Next groupcell
End Sub