VBA to classify items in a report

[alfordtp]

I have a report that is generated automatically in the following format:

	1	APPLE 1
	2	APPLE 2
	3	APPLE 3
	CLASS A	FRUIT
	5	BLUE 5
	6	BLUE 6
	7	BLUE 7
	8	BLUE 8
	REP12
	CLASS B	COLOR
	11	CIRCLE 11
	12	CIRCLE 12
	CLASS C	SHAPE

<tbody>
</tbody>

This goes on for around 10,000 rows. Where it says REP12 is where the report page break is and REP12 is the report number. Random placement.

I want to quickly add the class to column A of the table for each group. For example, the first group would read:

CLASS A	1	APPLE 1
CLASS A	2	APPLE 2
CLASS A	3	APPLE 3

<tbody>
</tbody>

As you can see, the way the report is originally formatted, there are spaces and sometimes other information in between the classes and item numbers.

Any thoughts as to which technique to write this VBA?

 

[hiker95]

alfordtp,

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G
1	1	APPLE 1
2	2	APPLE 2
3	3	APPLE 3
4
5	CLASS A	FRUIT
6
7	5	BLUE 5
8	6	BLUE 6
9	7	BLUE 7
10	8	BLUE 8
11
12	REP12
13
14	CLASS B	COLOR
15
16	11	CIRCLE 11
17	12	CIRCLE 12
18
19	CLASS C	SHAPE
20
Sheet1

After the macro using two arrays in memory:

Excel 2007
	A	B	C	D	E	F	G
1	1	APPLE 1			CLASS A	1	APPLE 1
2	2	APPLE 2			CLASS A	2	APPLE 2
3	3	APPLE 3			CLASS A	3	APPLE 3
4					CLASS B	5	BLUE 5
5	CLASS A	FRUIT			CLASS B	6	BLUE 6
6					CLASS B	7	BLUE 7
7	5	BLUE 5			CLASS B	8	BLUE 8
8	6	BLUE 6			CLASS C	11	CIRCLE 11
9	7	BLUE 7			CLASS C	12	CIRCLE 12
10	8	BLUE 8
11
12	REP12
13
14	CLASS B	COLOR
15
16	11	CIRCLE 11
17	12	CIRCLE 12
18
19	CLASS C	SHAPE
20
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ClassifyItems()
' hiker95, 10/09/2014, ME810818
Dim oa As Variant
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Dim lr1 As Long, lr2 As Long, h As String
Application.ScreenUpdating = False
Columns("E:G").ClearContents
lr1 = Cells(Rows.Count, "B").End(xlUp).Row
oa = Range("A1:B" & lr1)
With Range("A1:A" & lr1)
  .Value = Evaluate("IF(ROW(),SUBSTITUTE(" & .Address & ",""REP12"",""""),"""")")
End With
Range("A1:B" & lr1).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
lr2 = Cells(Rows.Count, "B").End(xlUp).Row
a = Range("A1:B" & lr2).Value
ReDim o(1 To lr2, 1 To 3)
For i = lr2 To 1 Step -1
  If InStr(a(i, 1), "CLASS") Then
    h = a(i, 1)
  Else
    j = j + 1
    o(j, 1) = h
    o(j, 2) = a(i, 1)
    o(j, 3) = a(i, 2)
  End If
Next i
Range("A1:B" & lr1) = oa
Range("E1:G" & lr2) = o
lr2 = Cells(Rows.Count, "E").End(xlUp).Row
Range("H1").Value = lr2
With Range("H2:H" & lr2)
  .FormulaR1C1 = "=R[-1]C-1"
  .Value = .Value
End With
Range("E1:H" & lr2).Sort key1:=Range("H1"), order1:=1
Range("H1:H" & lr2).ClearContents
Columns(5).Resize(, 3).AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ClassifyItems macro.

 

[hiker95]

alfordtp,

I want to quickly add the class to column A of the table for each group.

I missed this part.

Will be back later in the AM.

 

[Peter_SSs]

For the original sample data in post #1, can you show the complete result you want?

 

[hiker95]

alfordtp,

Sample raw data in the active worksheet:

Excel 2007
	A	B	C
1		1	APPLE 1
2		2	APPLE 2
3		3	APPLE 3
4
5		CLASS A	FRUIT
6
7		5	BLUE 5
8		6	BLUE 6
9		7	BLUE 7
10		8	BLUE 8
11
12		REP12
13
14		CLASS B	COLOR
15
16		11	CIRCLE 11
17		12	CIRCLE 12
18
19		CLASS C	SHAPE
20
Sheet1

After the macro using two arrays in memory:

Excel 2007
	A	B	C
1	CLASS A	1	APPLE 1
2	CLASS A	2	APPLE 2
3	CLASS A	3	APPLE 3
4
5		CLASS A	FRUIT
6
7	CLASS B	5	BLUE 5
8	CLASS B	6	BLUE 6
9	CLASS B	7	BLUE 7
10	CLASS B	8	BLUE 8
11
12		REP12
13
14		CLASS B	COLOR
15
16	CLASS C	11	CIRCLE 11
17	CLASS C	12	CIRCLE 12
18
19		CLASS C	SHAPE
20
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub ClassifyItemsV2()
' hiker95, 10/10/2014, ME810818
Dim a As Variant, b As Variant
Dim r As Long, lr As Long, h As String
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "C").End(xlUp).Row
b = Range("B1:C" & lr).Value
ReDim a(1 To lr, 1 To 1)
Columns(1).ClearContents
For r = lr To 1 Step -1
  If b(r, 1) = "" Or b(r, 1) = "REP12" Then
    'do nothing
  ElseIf InStr(b(r, 1), "CLASS") Then
    h = b(r, 1)
  ElseIf IsNumeric(b(r, 1)) Then
    a(r, 1) = h
  End If
Next r
Range("A1").Resize(lr, 1).Value = a
Columns(1).AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ClassifyItemsV2 macro.

 

[alfordtp]

This looks like what I need. Thanks. I'll test it out and report back.

 

[hiker95]

alfordtp,

This looks like what I need. Thanks.

Thanks for the feedback.

Your are very welcome.

I'll test it out and report back.

Will check back later this afternoon.

 

[Peter_SSs]

This looks like what I need.

In that case you might also like to have a look at this version. It has some slight differences to hiker's code, including ..

1. Mine assumes that column A is already empty per your sample whereas hiker's does not.

2. Mine relies on the last row (as determined by looking at column C) being a "Class" row whereas hiker's does not.

3. Mine does not rely on the Class labels containing the word "CLASS".

4. Mine does not rely on the page break text containing anything in particular (eg "REP12").

5. Mine does not rely on the rows to be labelled containing numerical values in column B.

6. On my machine and testing about 10,000 rows, this code was about one third faster (though with both codes taking less than one tenth of a second, speed shouldn't be a major issue for you ).

Sub Add_Class()
  Dim a As Variant
  Dim i As Long
  Dim Clss As String
  Dim b As Boolean
  
  a = Range("A1", Range("C" & Rows.Count).End(xlUp)).Value
  i = UBound(a, 1)
  Do
    If b Then
      Do Until a(i, 3) = ""
        a(i, 1) = Clss
        i = i - 1
        If i = 0 Then
          Range("A1").Resize(UBound(a, 1)).Value = a
          GoTo PreExit
        End If
      Loop
    Else
      Clss = a(i, 2)
      i = i - 1
    End If
    Do While a(i, 3) = ""
      i = i - 1
    Loop
    b = Not b
  Loop Until i = 0
  
PreExit:
End Sub