Identifying and separating groups of data.

[Matt]

Hi all,

I have eight data-sets (between 8,000-10,000 records each) that were
very clearly not setup by anyone who cared that people might one day
actually want to use the data.

The basic format is (at least with a fixed-width font):

Row Level Code Description
--- ----- ---- --------------
1 1 A001 Group_01
2 2 0570 Subgroup_01
3 3 0001 Widget_01
4 3 0002 Widget_02
5 3 0003 Widget_03
6 2 0598 Subgroup_01
7 3 0782 Subsubgroup_01
8 4 0001 Widget_11
9 4 0002 Widget_12
10 5 0001 Subwidget_121
11 5 0002 Subwidget_122
12 3 6387 Subsubgroup_02
13 3 0598 Subsubgroup_03
14 4 0001 Widget_01
15 4 0002 Widget_02
16 4 0003 Widget_03
17 2 0323 Subgroup_02

I hope this rather generic data-set captures what I'm trying to
demonstrate. Basically, the level and code fields are the key. The
data-set is hierarchical, but the data-tables don't make analysis easy.
The level indicates branches of a tree, similar to a file system
directory structure. Just imagine that it's machines, systems,
subsystems, and parts rather than drives, folders, sub-folders, and
files.

I have a list of codes that are considered critical. Unfortunately,
it's not a simple vlookup or index-match, but rather extracting all the
sub-records (identified by the level field) if I find a record with a
code that matches up to a code on my list.

To demonstrate using the data above, say codes 0782 and 0598 are on my
list of critical codes. For 0782, I need to extract or flag rows 7
through 11. For 0598, I need to extract of flag rows 13 through 16.

Furthermore, the data is such that the codes are not always unique and
are not always found on the same level. For instance, the group of
parts identified by 0782 could be at level 3 as in the example above,
but at level 5 elsewhere in the data. The sub-parts could also be
different even though they are both identified as 0782.

It gets further complicated in that the code isn't always a code, in
the example above, the 0001+ codes just indicate a sequence of parts,
their part numbers are identified by another field in the record.

Ideally, I'd like to make two modifications to the data. Initially, if
I find a record that has a critical code, I'd like to add an "x" to a
check field at the end of the record. Secondly, I'd like to separate
the group by inserting a row above and below the identified group.

The process, as I envision it, goes something like this:

Starting from record (row) 1, search the code field for a code that
matches my critical codes list (contained in another Excel file, only
about 140 records). When a record is identified, insert a row above
the record, place an "x" in the check field at the end of the record
and continue placing an "x" in the check field for all subsequent
records as long as the level (number) is greater than the level of the
record with the matching code. Once a record with an equal or lower
(numbered) level is found, insert a row to block off the chunk of data
and continue the process throughout the data-set.

I'm very much at a loss. I've been out of the country traveling for
fun for the past seven months and I've been away from Excel for almost
a year. I know there's a way to do this, it's just not coming to me.
Can anyone offer any assistance, it would be greatly appreciated.

Cheers,

Matt

 

[Toppers]

Matt,
Here's some starter code - not very sophisticated but hopefully
it will help you on your way. In the code you need to change the value of
"Lastcol" to suit your data- the "X" is placed here.


In your note you say for code 0598 flag rows 13 to 16; what about 0598 in
row 6?

Or was this a typo?


HTH

Option Explicit


Sub test()
' add code to loop through your list of codes
Call FilterGroups("0728")
End Sub

Sub FilterGroups(srchCode)

Dim lastrow As Long, r As Long, mc, n As Long, i As Integer
Dim Lastcol As Integer, blevel As Integer, inc As Integer
Dim srchRng As Range, c, firstaddress As String
Dim bCode As String
Dim strRows() As Long

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set srchRng = Worksheets("sheet1").Range("B2:B" & lastrow)
n = 0

' Search for all occurences of srchCode and store row numbers
With srchRng
Set c = .Find(srchCode, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
n = n + 1
ReDim Preserve strRows(n)
strRows(n) = c.Row
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End With
' Nothing found .....
If n = 0 Then
MsgBox "No occurences of code " & srchCode & " found"
Exit Sub
End If

Lastcol = 6 ' <======= Change to your requirement
inc = 0
' for each occurence of "srchCode" insert a blank line, mark rows with "X"
in "Lastcol"
' and insert blank line at end of each group
For i = 1 To n
r = strRows(i) + inc
Rows(r).Select
Selection.Insert Shift:=xlDown ' Insert blank row

r = r + 1
Cells(r, Lastcol) = "X"
blevel = Cells(r, 1) ' Store level of "SrchCode"

r = r + 1
Do While Cells(r, 1) > blevel ' Add "X" if level > than level of
"srchCode"
Cells(r, Lastcol) = "X"
r = r + 1
Loop

Rows(r).Select
Selection.Insert Shift:=xlDown ' insert blank row
inc = inc + 2 ' Allow for inserted pairs of blank lines
Next

End Sub

 

[Matt]

Thanks! I'll give this a shot. And the code in row 6 was a typo, I
was just putting random numbers in to "make" a set of data since the
actual data is covered by an NDA. I'm sure I'll be back with
questions, my VB is pretty rusty.

Thanks again,

Matt

 

[Matt]

Hi all,

Here we go again. Thanks to Toppers, I now have working code that is
starting to do what I want it to do. I've modified the code to the
following, changing the way it works a bit (I removed the code that
inserted spaces above and below the data, realizing it was doing more
harm than good for my purposes) and also formatting it so it was easier
for me to understand:

========================================================================
Option Explicit

Sub Test()
'Need code to loop through critical list.
Call FilterGroups("1234")
End Sub

Sub FilterGroups(SearchCode)

Dim LastRow As Long 'Last row of dataset
Dim SearchRange As Range 'Search range
Dim n As Long 'Current loop step
Dim c '
Dim FirstAddress As String '
Dim StoreRows() As Long '
Dim Check As Integer 'Check column
Dim i As Integer 'Incremental for retrieving stored rows
Dim r As Integer 'Current row
Dim bLevel As Integer 'Level of found code

LastRow = Cells(Rows.Count, "A").End(xlUp).Row 'Find and set last
row

Set SearchRange = Worksheets("Raw Data").Range("B2:B" & LastRow)
'Set search range

n = 0 'Set n variable to zero

'Search for all occurences of SearchCode and store row numbers
With SearchRange
Set c = .Find(SearchCode, LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
n = n + 1
ReDim Preserve StoreRows(n)
StoreRows(n) = c.Row
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
End With

If n = 0 Then 'Exit routine if search code was not found
MsgBox "Code " & SearchCode & " could not be found"
Exit Sub
End If

Check = 15 'Check column number

'For each occurence of "SearchCode" mark rows with "x" in "Check"
For i = 1 To n
r = StoreRows(i)
Cells(r, Check) = "x"
bLevel = Cells(r, 1) 'Store level of "SearchCode"
r = r + 1
Do While Cells(r, 1) > bLevel 'Add "x" if level > than level of
"SearchCode"
Cells(r, Check) = "x"
r = r + 1
Loop
Next

MsgBox "Search Complete"

End Sub
========================================================================

I now need to search from list of critical values, not just a single
value as in the code above ("1234"). Say I have a workbook titled
"critical_codes.xls" with a tab named "critical". The critical tab
looks something like this in column A. For aguments sake, say the
range is A1:A100:

Code
----
1241
2365
....
3585
5843

I can't seem to get the macro to reference this list to get the values
for SearchCode. The program isn't very happy with more than one value
for SearchCode. I'm sure this is very simple and I feel like a dunce
for even asking, but I'm at a loss.

Any help is greatly appreciated.

Best regards,

Matt

 

[Norman Jones]

Hi Matt,

Try something like:

Sub Test()
Dim arr As Variant
Dim i As Long

arr = Array("1241", "2365", "3585", "5843")

For i = LBound(aar) To UBound(arr)
Call FilterGroups(arr(i))

End Sub

 

[Norman Jones]

Hi Matt,

Correcting, try:

Sub Test()
Dim arr As Variant
Dim i As Long

arr = Array("1241", "2365", "3585", "5843")

For i = LBound(arr) To UBound(arr)
Call FilterGroups(arr(i))
Next i

End Sub

 

[Matt]

Thanks Norman,

What I really need to do is use the list of codes in the
critical_codes.xls file. Is there a way to specfiy a particular range
in that file as the array and then use the method you've described?
Thanks for your help.

Best regards,

Matt

 

[Norman Jones]

Hi Matt,

Try:

Sub Test2()
Dim rng As Range
Dim rCell As Range
Set rng = Range("A1:A4") '<<======= CHANGE

For Each rCell In rng
If Not IsEmpty(rCell) Then
Call FilterGroups(rCell.Value)
End If
Next rCell

End Sub

 

[Matt]

Thanks Norman,

I think I can take it from here. You've been a big help.

- Matt