Jumat, 08 Februari 2013

[ExcelVBA] Is there a better way to populate textboxes. I'm using a combobox, vba &vlookup

 


Hi,

I have a combobox,cboPricingInstruction, with 43 columns populated by a
dynamic range, PricingInstruction.

I'm using vlookup to populate the price breaks. When a vlookup argument
isn't found, it returns an error.

Generally, the errors occur in the core price calculation section of the
code below.

Is there a better way to populate the textboxes?

I included a screen shot of the user form.

Thanks for any suggestions.

Dan

Here's the vba for cboPricingInstruction:

Private Sub cboPricingInstruction_Change()
On Error Resume Next
Dim myCoreRange As Range
Set myCoreRange = Worksheets("tblPriceListCorePart").Range("CorePrices")

Dim myEntryRange As Range
Set myEntryRange =
Worksheets("tblPriceListEntryAdder").Range("EntryPrices")

Me.txtCoreComp.Value = Me.cboPricingInstruction.Column(1)
Me.txtCoreMultiplier.Value = Me.cboPricingInstruction.Column(2)
Me.txtAdapterConfig.Value = Me.cboPricingInstruction.Column(3)
Me.txtRequiredEntryAdder.Value = Me.cboPricingInstruction.Column(4)
Me.txtRequiredEnv.Value = Me.cboPricingInstruction.Column(5)
Me.txtCheckedBy.Value = IIf(Len(Me.cboPricingInstruction.Column(31)) >
0, "Checked by " & Me.cboPricingInstruction.Column(31), "Not Checked")
Me.txtCheckByDt.Value = Format(Me.cboPricingInstruction.Column(32),
"MM/DD/YYYY")
Me.txtAppBy.Value = IIf(Len(Me.cboPricingInstruction.Column(20)) > 0,
"Approved By " & Me.cboPricingInstruction.Column(20), "Not Approved")
Me.txtApprovedByDt.Value = Format(Me.cboPricingInstruction.Column(19),
"MM/DD/YYYY")
Me.txtEnteredBy.Value = IIf(Len(Me.cboPricingInstruction.Column(22)) >
0, "Entered by " & Me.cboPricingInstruction.Column(22), "Notify
supervisor.")
Me.txtEnteredByDt.Value = Format(Me.cboPricingInstruction.Column(26),
"MM/DD/YYYY")
Me.txtRevDt.Value = IIf(Len(Me.cboPricingInstruction.Column(40)) > 0,
Me.cboPricingInstruction.Column(40), "Notify supervisor.")
Me.txtComment.Value = Me.cboPricingInstruction.Column(21) & Chr(10) &
Me.cboPricingInstruction.Column(27)

'Core price calculation
Me.txtCorePB1.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 5,
False) * txtCoreMultiplier.Value
Me.txtCorePB2.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 6,
False) * txtCoreMultiplier.Value
Me.txtCorePB3.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 7,
False) * txtCoreMultiplier.Value
Me.txtCorePB4.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 8,
False) * txtCoreMultiplier.Value
Me.txtCorePB5.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 9,
False) * txtCoreMultiplier.Value
Me.txtCorePB6.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 10,
False) * txtCoreMultiplier.Value
Me.txtCorePB7.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 11,
False) * txtCoreMultiplier.Value
Me.txtCorePB8.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 12,
False) * txtCoreMultiplier.Value
Me.txtCorePB9.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 13,
False) * txtCoreMultiplier.Value
Me.txtCorePB10.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 14,
False) * txtCoreMultiplier.Value

'Entry price Calculation
Me.txtCorePB1.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 5,
False) * txtCoreMultiplier.Value
Me.txtCorePB2.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 6,
False) * txtCoreMultiplier.Value
Me.txtCorePB3.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 7,
False) * txtCoreMultiplier.Value
Me.txtCorePB4.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 8,
False) * txtCoreMultiplier.Value
Me.txtCorePB5.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 9,
False) * txtCoreMultiplier.Value
Me.txtCorePB6.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 10,
False) * txtCoreMultiplier.Value
Me.txtCorePB7.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 11,
False) * txtCoreMultiplier.Value
Me.txtCorePB8.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 12,
False) * txtCoreMultiplier.Value
Me.txtCorePB9.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 13,
False) * txtCoreMultiplier.Value
Me.txtCorePB10.Value = WorksheetFunction.VLookup(Me.txtCoreComp.Value &
Me.txtAdapterConfig.Value & Me.txtShellSize.Value, myCoreRange, 14,
False) * txtCoreMultiplier.Value

End Sub

[Non-text portions of this message have been removed]

__._,_.___
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (1)
Recent Activity:
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------
.

__,_._,___

Tidak ada komentar:

Posting Komentar