Creating a report

[O177812]

I am trying to create a list using my data.

I have 26 columns and some of them contain data and some of them contain Error.

I want to write a formula that will copy the Item number (Column A) and then will list the header for each error by item.

See below:

ITEM	TITLE	FIX	ENDER	STAIN	FINISH
14620	ERROR	PIN	ERROR	RED	RED
15712	GLOBAL TURNKIT	ERROR	PLASTIC	GREEN	GREEN
18921	MEGA KIT	PIN	METAL	BLUE	BLUE

<tbody>
</tbody>

I would like my report to look like this

________________


14620:

TITLE
ENDER

15712:

FIX

18921:

NO ERRORS

_________________


This data could appear at the end of each line until I figure out how to write VBA so that it will open up a word document and copy the information on a different sheet.

Thanks for the help.

 

[ranman256]

Public Sub BuildRpt()
Dim colFlds As New Collection
Dim c As Long
Dim shtData As Worksheet, shtRpt As Worksheet
Dim vItm
Dim bFound As Boolean


  'start at top of report get fld names
Set shtData = ActiveSheet
Range("A1").Select
While ActiveCell.Value <> ""    'get headers
   colFlds.Add ActiveCell.Value
   ActiveCell.Offset(0, 1).Select  'next col
Wend

'scan data, find the errors
Sheets.Add
Set shtRpt = ActiveSheet
shtData.Activate
Range("A2").Select
While ActiveCell.Value <> ""    'scan all the data for error
   For c = 0 To colFlds.Count - 1
      vItm = ActiveCell.Value
      If ActiveCell.Offset(0, c).Value = "ERROR" Then
         If Not bFound Then
            shtRpt.Activate
            ActiveCell.Value = vItm
            shtData.Activate
         End If
         
          bFound = True
         shtRpt.Activate
         ActiveCell.Offset(1, 0).Select  'next row
         ActiveCell.Value = colFlds(c)
         shtData.Activate
      End If
   Next
   If bFound Then
      shtRpt.Activate
      ActiveCell.Offset(1, 0).Select  'next row
      shtData.Activate
   End If
   
   ActiveCell.Offset(1, 0).Select  'next row
   bFound = False
Wend

  'memory cleaner
Set colFlds = Nothing
Set shtData = Nothing
Set shtRpt = Nothing
End Sub

 

[O177812]

I keep getting an error on this