Slightly Complicated VBA, awaiting a simple Solution

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


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:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Hi & welcome to MrExcel.
You'll have a better chance of getting some help, if you can tell us what is wrong.
 
Upvote 0
Possible causes of the problem would be you not having range names called: Supplier, Category, Product, UOM and Code.

If you could identify the line that was causing the problem, we wouldn't need to guess.
I'm not able to debug the error.

Are you saying you don't know how to debug? Or you don't yet have access to the VB Editor, and are relying on the workbook/code as originally downloaded?

I have a feeling you'd be better off defining your problem, rather than picking up someone else's code that may not be appropriate, and may not even work?
 
Upvote 0
Hi,

Yes, since i am not very good at coding(even VBA) i had downloaded an existing template which kinda looked like what i needed.
To this i had added my data which worked seamlessly, but then I added another column called "UOM" to the master data & another combobox to the userform.
I modified the Code based on some basic principles but that has resulted in a deadend.

Since then i am not able to execute the program.
Both the files are uploaded in the below link :
https://ufile.io/81lvy

Would love to hear what the issue is.

Regards,
Eric
 
Upvote 0
As Stephen pointed out in post#4 you are missing a named range. In this case UOM.
 
Upvote 0
As Stephen pointed out in post#4 you are missing a named range. In this case UOM.

Hi,

Thanks for pointing it out, however i am not sure how to get that done, i did check if the Name box had any specific names to it but nothing. Could you please tell me how to get it done.
Also an update, in the userform code I changed
Private Sub UserForm_Initialize() to Private Sub UserForm1_Initialize()

After doing this the VBA runs without any glitches, but once the userform loads up, there are no values in the comboboxes.
Does this help point out the exact issue.

Would be helpful if you could take a look at the codes above.

Regards,
Eric
 
Upvote 0
i did check if the Name box had any specific names to it but nothing.

If you open Name Manager, you'll see you have several dynamic range names, e.g.

Category: =OFFSET(Database!$B$2,0,0,COUNTA(Database!$B:$B)-1)

You're missing UOM, which for consistency would be:

=OFFSET(Database!$E$2,0,0,COUNTA(Database!$E:$E)-1)

You could also avoid the volatile OFFSET() function by using: =Database!$E$2:INDEX(Database!$E:$E,COUNTA(Database!$E:$E))
 
Last edited:
Upvote 0
Also an update, in the userform code I changed
Private Sub UserForm_Initialize() to Private Sub UserForm1_Initialize()

Sub UserForm_Initialize will run when the UserForm initialises, i.e. when it is loaded to memory.

It doesn't matter what you call the UserForm: Sub UserForm_Initialize is the required syntax.

If you change the name of this Sub in any way it won't run when the Userform initialises.
 
Upvote 0

Forum statistics

Threads
1,224,798
Messages
6,181,037
Members
453,013
Latest member
Shubashish_Nandy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top