Error Handling

[lifeson]

Obviously I have this error handling wrong but cannot see where


For r = 2 To srcRow
'declare variables
entityID = .Cells(r, "K").Value
iType = .Cells(r, "L").Value
compQty = .Cells(r, "F").Value

If iType = 1 Then
'add component description & price from sheet tblPrice
On Error GoTo NoMatch
'if entityID has no matching record in TblPrice then do not add and go to next entity
compDesc = Application.VLookup(entityID, shPrice.Columns("A:C"), 2, False)
compPrice = Application.VLookup(entityID, shPrice.Columns("A:C"), 3, False)
Sheets("QuoteDetail").Select
Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1).Select
ActiveCell = entityID
ActiveCell.Offset(0, 1) = compDesc
ActiveCell.Offset(0, 2) = compPrice
ActiveCell.Offset(0, 3) = compQty
End If
NoMatch:
MsgBox "no match in TblPrice for entity: " & entityID

Next r

[mdmackillop]

Can you post the full code?

BTW, rather than selecting QuoteDetail, write the values directly as

Dim rng As Range
Set rng = Sheets("QuoteDetail").Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1)
rng = entityID
rng.Offset(0, 1) = compDesc
rng.Offset(0, 2) = compPrice
rng.Offset(0, 3) = compQty

[Bob Phillips]

I wouldn't use a huge dredger net to catch errors like but, but ...



For r = 2 To srcRow
'declare variables
entityID = .Cells(r, "K").Value
iType = .Cells(r, "L").Value
compQty = .Cells(r, "F").Value

If iType = 1 Then
'add component description & price from sheet tblPrice
On Error GoTo NoMatch
'if entityID has no matching record in TblPrice then do not add and go to next entity
compDesc = Application.VLookup(entityID, shPrice.Columns("A:C"), 2, False)
compPrice = Application.VLookup(entityID, shPrice.Columns("A:C"), 3, False)
Sheets("QuoteDetail").Select
Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1).Select
ActiveCell = entityID
ActiveCell.Offset(0, 1) = compDesc
ActiveCell.Offset(0, 2) = compPrice
ActiveCell.Offset(0, 3) = compQty
End If
GoTo Continue
NoMatch:
MsgBox "no match in TblPrice for entity: " & entityID
Resume Continue:
Continue:
Next r

[lifeson]

Can you post the full code?

BTW, rather than selecting QuoteDetail, write the values directly as

Dim rng As Range
Set rng = Sheets("QuoteDetail").Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1)
rng = entityID
rng.Offset(0, 1) = compDesc
rng.Offset(0, 2) = compPrice
rng.Offset(0, 3) = compQty


I have added the workbook with an additional button (mdmckillop) to run the code as suggested but when I try that, I am missing the first few components?

The button Get Materials gives me the results I want but are you suggesting that it is not the best way?
The real data will be typically 4-5000 rows to search of prices and 10000 packmaterial links so anything to make it run more efficiently would be appreciated.

[lifeson]

Thanks XLD (twice today) the error handling code works fine

[mdmackillop]

You can speed up code by avoiding "Select". It's very rarely needed.

Private Sub CommandButton1_Click()
Dim entityID As String
Dim r As Long, i As Long
Dim iType As Long
Dim srcRow As Long, packRow As Long, priceRow As Long
Dim matID As String, matDesc As String
Dim compDesc As String
Dim matQty As Long
Dim matPrice As Double, compPrice As Double
Dim shTarget As Worksheet
Dim shPrice As Worksheet
Dim shMat As Worksheet
Dim rng As Range
Application.ScreenUpdating = False
Set shTarget = Worksheets("QuoteDetail")
Set shPrice = Worksheets("NWAC")
Set shMat = Worksheets("TblPackMat")
Set rng = shTarget.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1)
With Sheets("TblQuoteLine")
srcRow = .Cells(.Rows.Count, "A").End(xlUp).row
packRow = shMat.Cells(shMat.Rows.Count, "A").End(xlUp).row - 1
priceRow = shPrice.Cells(shPrice.Rows.Count, "A").End(xlUp).row - 1
For r = 2 To srcRow
'assign variables
iType = .Cells(r, "L").Value
entityID = .Cells(r, "K").Value
packQty = .Cells(r, "F").Value
Select Case iType
Case Is = 1
'MsgBox entityID & " " & iType & " " & packQty
'If iType = 1 Then
'add component description & price from sheet tblPrice
On Error GoTo NoMatch
'if entityID has no matching record in TblPrice then do not add and go to next entity
compDesc = Application.VLookup(entityID, shPrice.Columns("A:C"), 2, False)
compPrice = Application.VLookup(entityID, shPrice.Columns("A:C"), 3, False)
Set rng = shTarget.Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1)
With rng
.Value = entityID
.Offset(0, 1) = compDesc
.Offset(0, 2) = compPrice
.Offset(0, 3) = packQty
.Offset(0, 4) = packQty * compPrice
End With
'End If
'GoTo Continue
NoMatch:
If Err <> 0 Then
MsgBox "no match in TblPrice for entity: " & entityID
Resume Next
End If
'Continue:
Case Is = 2
'If iType = 2 Then 'get linked materials
For i = 2 To packRow
'MsgBox "For entity: " & entityID & " check row: " & i & " of: " & packRow
If shMat.Cells(i, "A").Value = entityID Then
matID = shMat.Cells(i, "B").Value
matQty = shMat.Cells(i, "C").Value
packQty = Cells(i, "F").Value
matDesc = Application.VLookup(matID, shPrice.Columns("A:C"), 2, True)
matPrice = Application.VLookup(matID, shPrice.Columns("A:C"), 3, True)
'add MATID to list
Set rng = Sheets("QuoteDetail").Cells(Rows.Count, 1).End(xlUp).Offset(1)
With rng
.Value = matID
.Offset(0, 1) = matDesc
.Offset(0, 2) = matPrice
.Offset(0, 3) = matQty
.Offset(0, 4) = matQty * matPrice
End With
End If
Next i
'End If
End Select
Next r
'.Activate
Application.ScreenUpdating = True
End With
'shTarget.Select
End Sub

Private Sub UserForm_Initialize()
'Clear existing detail
With Sheets("QuoteDetail")
Range(.Range("A2:E2"), .Range("A2:E2").End(xlDown)).ClearContents
End With
End Sub

[lifeson]

Thanks md
I've picked up a few pointers there

use Case instead of if...then
and a better way of clearing the sheet.

Thanks