Help with VBA code for reliability report

[Henning Hagen]

I have pulled out all my hair, so I hope someome can help me...
I have an aircraft reliability report in Excel, in which data have been
manually input until now. The format of the worksheets and graphs works well,
so I don't want to change it. The data sheets in this file have the last 24
months in column B to Y (date format like aug.06). The actual months will be
updated every time the report is issued. The data sheets also have something
called ATA codes. These are located in A9 to A42 (text format with values
like 21, 22, 32,56) This range and the values never change. To illustrate, it
looks like this:

Sheet920011
|A |B |C |
5 | |Okt.04 |Nov.04 |

9 |21 | | |
10|22 | | |
12|24 | | |

There are lots of other columns/fields for flying hours and calculations,
but that is not important for what I need. There is one matrix (sheet) like
above for each serialnumber aircraft.

I now run a query in an Oracle application to get the data which will go into
the matrix above. This query gives me aircraft serialnumber, month (as in
row 5
above), ATA code (as in column A above), and number of occurances per
aircraft.
Structure is occurances per ATA code per month per serialnumber . Note that
the number of records will vary if there are no occurances of a particular
ATA code. When I have imported the data to a sheet in the Excel file, sorted
by A, B, C, it
looks like this:

Inputsheet
|A |B |C |D |
1|920011|Okt.04 |21 |5 |
2|920011|Okt.04 |24 |2 |
3|920011|Nov.04 |22 |4 |

I have tried all kinds of different ways to put the right data in the right
place, without success.

What I need is some VBA code which loops through the inputsheet, finds the
data
based on criteria from sheet920011 A9:A42 (fixed values) and B5:Y5 (variable
values), and copies it into the corresponding cell in sheet920011. With the
correct code, looking at the example above, Inputsheet D1 should go to
Sheet920011 B9, D2 to B12, and D3 to C10.

I really hope some of you with guru status can help me here.

 

[Nigel]

Hi,
Try this - I have assumed the following
1. Your input data is stored in a sheet named InputSheet and data starts in
row 1
2. That your target sheets are named Sheet followed by the serial number
supplied in column 1 of your InputSheet
3. That Reference rows for DATES are in row 5 (columns 2 to 25); and ATA
codes are in column 1 rows 9 to 42

The code checks that the target sheet exists, if it does it checks for the
date, then the ATA code, if all are OK then copies the InputSheet column 4
value into the appropriate cell. If there is an error, then the specific
faulting value (serial no, date or ATA code in that order) are highlighted
on the input sheet in red. A message box confirms completion of the
process, and error count if there are any.

Put the code into a standard VBA module. Hope this suits your needs


Sub CopyInputData()
' get last row of input data
Dim xlr As Long, shList As Worksheet
Set shList = Sheets("InputSheet")
With shList
xlr = .Cells(Rows.Count, 1).End(xlUp).Row
End With

' scan the input sheet
Dim xr As Long, xc As Integer, xsr As Integer
Dim xtc As Integer, xtr As Integer
Dim shTarget As Worksheet, xShNo As String
Dim NoError As Boolean, xErrors As Long

xr = 1: xErrors = 0
Do While xr <= xlr
NoError = True
xShNo = Trim(CStr(shList.Cells(xr, 1)))
On Error GoTo shError
Set shTarget = Sheets("Sheet" & xShNo)
If NoError Then
Do While xShNo = shList.Cells(xr, 1)
'locate date column
xtc = 0
For xc = 2 To 25
If shList.Cells(xr, 2) = shTarget.Cells(5, xc) Then xtc = xc
Next
If xtc = 0 Then
shList.Cells(xr, 2).Interior.ColorIndex = 3
xErrors = xErrors + 1
Else
' go get the ATA code
xtr = 0
For xsr = 9 To 42
If shList.Cells(xr, 3) = shTarget.Cells(xsr, 1) Then xtr = xsr
Next
If xtr = 0 Then
shList.Cells(xr, 3).Interior.ColorIndex = 3
xErrors = xErrors + 1
Else
shTarget.Cells(xtr, xtc) = shList.Cells(xr, 4)
End If
End If
xr = xr + 1
Loop
Else
xr = xr + 1
End If
Loop

If xErrors > 0 Then
MsgBox "Total Errors " & xErrors
Else
MsgBox "No Errors"
End If

Exit Sub
shError:
shList.Cells(xr, 1).Interior.ColorIndex = 3
xErrors = xErrors + 1
NoError = False
Resume Next
End Sub

 

[Henning Hagen]

Dear Nigel,

Your solution worked perfectly. Thank you very much. In fact, with some
small changes, I'll be able to used it for other similar tasks too. Thanks
again.

Regards,
Henning

 

[Nigel]

Hi Henning

Glad it worked and has other uses as well - I also hope your hair grows
back - LOL