ericjohn007
New Member
- Joined
- May 9, 2018
- Messages
- 4
Hi Folks,
I have an issue modifying an existing VBA template that i got of the INTERNET, & since im not good at coding myself i am stuck with an issue.
Its a userform which helps populate a quotation from a master DB
I have put below the code here, and if u go through it once you will notice the issue i am currently facing.
Would love to hear from the community for a solution on this.
Worksheet Selectionchange
Maincode
Regards,
Eric
I have an issue modifying an existing VBA template that i got of the INTERNET, & since im not good at coding myself i am stuck with an issue.
Its a userform which helps populate a quotation from a master DB
I have put below the code here, and if u go through it once you will notice the issue i am currently facing.
Would love to hear from the community for a solution on this.
Worksheet Selectionchange
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A13:A39")) Is Nothing And Target.Count = 1 Then
UserForm1.Left = Target.Left + 25
UserForm1.Top = Target.Top + 20 - Cells(ActiveWindow.ScrollRow, 1).Top
UserForm1.Show
Else
Exit Sub
End If
End Sub
Maincode
Code:
Option Compare Text
Dim tablo2(), tablo3(), tablo4(), Category(), Supplier(), Product(), UOM(), Code(), SD As Object, bul As String, c As Variant, i As Long
Private Sub UserForm_Initialize()
Supplier = Application.Transpose(Range("Supplier"))
Category = Application.Transpose(Range("Category"))
Product = Application.Transpose(Range("Product"))
UOM = Application.Transpose(Range("UOM"))
Code = Application.Transpose(Range("Code"))
Set SD = CreateObject("Scripting.Dictionary")
For Each x In Supplier
SD(x) = ""
Next x
ComboBox1.List = SD.keys
End Sub
Private Sub ComboBox1_Change()
Dim a, b As Long, k As Variant
If ComboBox1.ListIndex = -1 And IsError(Application.Match(ComboBox1, Supplier, 0)) Then
Set SD = CreateObject("Scripting.Dictionary")
bul = ComboBox1 & "*"
For Each c In Supplier:
If c Like bul Then SD(c) = ""
Next c
ComboBox1.List = SD.keys
ComboBox1.DropDown
Else
Evn = ComboBox1
If Evn = "" Then Exit Sub
Set d2 = CreateObject("Scripting.Dictionary")
For i = LBound(Category) To UBound(Category)
If Supplier(i) = Evn Then d2(Category(i)) = ""
Next i
tablo2 = d2.keys
ComboBox2.List = tablo2
'For alphabetic order
For a = 0 To ComboBox2.ListCount - 1
For b = a To ComboBox2.ListCount - 1
If ComboBox2.List(b) < ComboBox2.List(a) Then
k = ComboBox2.List(a)
ComboBox2.List(a) = ComboBox2.List(b)
ComboBox2.List(b) = k
End If
Next
Next
ComboBox2.SetFocus
If Val(Application.Version) > 10 Then SendKeys "{f4}"
ComboBox1.BackColor = &H80FFFF
End If
End Sub
Private Sub ComboBox2_Change()
If ComboBox1 <> "" Then
If ComboBox2.ListIndex = -1 And IsError(Application.Match(ComboBox2, Category, 0)) Then
Set SD = CreateObject("Scripting.Dictionary")
bul = UCase(ComboBox2) & "*"
For Each c In tablo2
If UCase(c) Like bul Then SD(c) = ""
Next c
ComboBox2.List = SD.keys
ComboBox2.DropDown
Else
Set d3 = CreateObject("Scripting.Dictionary")
ara_1 = ComboBox1
ara_2 = ComboBox2
If ara_1 = "" Or ara_2 = "" Then Exit Sub
Set d3 = CreateObject("Scripting.Dictionary")
For i = LBound(Product) To UBound(Product)
If Supplier(i) = ara_1 And Category(i) = ara_2 Then d3(Product(i)) = ""
Next i
tablo3 = d3.keys
ComboBox3.List = tablo3
ComboBox3.SetFocus
If Val(Application.Version) > 10 Then SendKeys "{f4}"
End If
ComboBox2.BackColor = &H80FFFF
End If
End Sub
Private Sub ComboBox3_Change()
If ComboBox1 <> "" And ComboBox2 <> "" Then
If ComboBox3.ListIndex = -1 And IsError(Application.Match(ComboBox3, Product, 0)) Then
Set SD = CreateObject("Scripting.Dictionary")
bul = UCase(ComboBox3) & "*"
For Each c In tablo3
If c Like bul Then SD(c) = ""
Next c
ComboBox3.List = SD.keys
ComboBox3.DropDown
Else
Set d4 = CreateObject("Scripting.Dictionary")
ara_1 = ComboBox1.Text
ara_2 = ComboBox2.Text
ara_3 = ComboBox3.Value
If ara_1 = "" Or ara_2 = "" Or ara_3 = "" Then Exit Sub
Set d4 = CreateObject("Scripting.Dictionary")
For i = LBound(Product) To UBound(Product)
If Supplier(i) = ara_1 And Category(i) = ara_2 And Product(i) = CStr(ara_3) Then d4(UOM(i)) = ""
Next i
tablo4 = d4.keys
ComboBox4.List = tablo4
ComboBox4.SetFocus
If Val(Application.Version) > 10 Then SendKeys "{f4}"
End If
ComboBox3.BackColor = &H80FFFF
End If
End Sub
Private Sub ComboBox4_Change()
If ComboBox1 <> "" And ComboBox2 <> "" And ComboBox3 <> "" Then
If ComboBox4.ListIndex = -1 And IsError(Application.Match(ComboBox4, UOM, 0)) Then
Set SD = CreateObject("Scripting.Dictionary")
bul = UCase(ComboBox4) & "*"
For Each c In tablo4
If c Like bul Then SD(c) = ""
Next c
ComboBox4.List = SD.keys
ComboBox4.DropDown
Else
ara_1 = ComboBox1.Text
ara_2 = ComboBox2.Text
ara_3 = ComboBox3.Value
ara_4 = ComboBox4.Text
For i = LBound(Product) To UBound(Product)
If Supplier(i) = ara_1 And Category(i) = ara_2 And Product(i) = CStr(ara_3) And UOM(i) = ara_4 Then
TextBox1.Value = Format(Code(i), "#,##0.00")
End If
Next i
End If
ComboBox4.BackColor = &H80FFFF
End If
End Sub
Private Sub CommandButton1_Click()
If ComboBox1 <> "" And ComboBox2 <> "" And ComboBox4 <> "" Then
ActiveCell = UCase(ComboBox1)
ActiveCell.Offset(, 2) = ComboBox2
ActiveCell.Offset(, 1) = ComboBox3
ActiveCell.Offset(, 3) = ComboBox4
ActiveCell.Offset(, 5) = TextBox1
ActiveCell.Offset(, 4) = ActiveCell.Offset(, 4) * 1
Unload Me
Else
MsgBox "Error!"
Exit Sub
End If
End Sub
Regards,
Eric
Last edited by a moderator: