Add cell content via a form/window

[notty dread]

hi guys,

I have a database of products (car parts) with description price, quantity etc.
I am writing the descriptions, howveer need to include the compatability of the products.
I am looking for a macro that will:

Open a window with a drop down list of car types, followed by a tick box list of engine types/sizes and an ok and a 'more' button.

When ok'ed, this should add the text of the car type/ engine sizes to the cell containing the product description.

When 'more' is pressed it needs to hodl the previous entry and add the next entry (and any further ones to it).

The thing is...

I need this to be able to be done any number of times for each cell - so that I can add any number of compatible cars/engines and when i click on ok, it will add ALL the types/engine sizes i have chosen.

Any help is greatly appreciated.

 

[Andrew Poulsom]

Let's say that your list of products is in column A on Sheet1 and your description is in column B with headings in row 1. Activate your worksheet and press Alt+F11 to go to the Visual Basic Editor. Click your workbook in the Project window and choose Insert|UserForm from the menu. Add a ComboBox, a ListBox and 2 CommandButtons to the UserForm. From the menu choose View|Code. Paste this code into the window on the right:

Dim Sh As Worksheet
Dim Rng As Range
 
Private Sub UserForm_Initialize()
    Set Sh = Worksheets("Sheet1")
    With Sh
        Set Rng = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    ComboBox1.List = Rng.Value
    With ListBox1
        .AddItem "Type1 1200cc"
        .AddItem "Type1 2000cc"
        .AddItem "Type2 1500cc"
        .AddItem "Type2 2000cc"
        .AddItem "Type3 1400cc"
        .AddItem "Type3 1800cc"
        .MultiSelect = fmMultiSelectExtended
    End With
    CommandButton1.Caption = "OK"
    CommandButton2.Caption = "Cancel"
End Sub
 
Private Sub CommandButton1_Click()
    Dim i As Integer
    With Rng.Cells(ComboBox1.ListIndex + 1, 2)
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                If .Value = "" Then
                    .Value = ListBox1.List(i)
                Else
                    .Value = .Value & "," & ListBox1.List(i)
                End If
            End If
        Next i
    End With
End Sub
 
Private Sub CommandButton2_Click()
    Unload Me
End Sub

Change the lisbox list to suit.

From the menu choose Insert|Module and paste this code into the window on the right:

Sub Test()
    UserForm1.Show
End Sub

Press Alt+F11 to return to your worksheet, right click any Toolbar and click Forms. Click the CommandButton icon on the Forms Toolbar and click and drag on your worksheet to size and position it. When prompted assign it the Test macro above.

Now click the CommandButton to try it out. You can select multiple items from the ListBox by holding down Ctrl or Shift while clicking.

 

[notty dread]

Many thanks for such a quick response, I will try this tonight and get back to you on this thread tomorrow.

Once again - thanks!

 

[notty dread]

Hi andy,

I tried that out and it worked, kind of. The form works, but doesn't write the selections to the cell (whichever cell is selected). Thanks for your help, i'll try and explain it better...

I have 2 sheets: ProdDatabase & ProdLists

ProdDatabase: Is a list of 15,000 car parts!
Col A is a product id
Col B is a product description

ProdLists: is a list of Car Makes
Col H is the column containing the list of cars

When I am editing the text description of the product in ProdDatabase i want to be able to activate a macro that opens the form.

I got the form to work using the list of cars from sheet ProdList and have added some engine sizes - that bit work great.

What i need to happen is that when the form opens, I select the car make from the list, click on the multiple engine sizes and then click on ok - but i want to be able to do this multiple times for different car types and engine sizes.

Then when finished doing the multiple entries i need to be able to click a button and append the whole lot to the cell i have currently selected (it will be the car description on the ProdDatabase sheet).

I think the form needs another button called 'done' and the 'ok' button should be changed to 'next' and allow me to repeat the car selection/engine size process (adding it all together as it goes).

When it stores the car type and engine size - it should be like cartype+enginesize.selected1, cartype+enginesize.selected2, cartype+enginesize.selected3, cartype+enginesize.selected5.

e.g. Audi 1.4ltr, Audi 1.6ltr, Audi 2.0ltr

When i do this multiple time it would be like adding this to whatever cell I was in:

Car description lorem ipsum verbum, in prinicpio erat verbum, erat verbum apud dominus, apud deus.
Audi 1.4ltr, Audi 1.6ltr, Audi 2.0ltr
BMW 1.4ltr, BMW 1.6ltr, BMW 2.0ltr
Citroen 1.2ltr, Citroen 1.8ltr, Citroen 2.4ltr

I truly appreciate your help, and hope you can point me in the right direction. I have tried to edit your code to do this, but i'm not quite there with VB (better at javascript!).

Thanks, Notty D.

 

[Norie]

Notty

I'm sure this is possible, but are you sure it's the right way to do things?

You are going to end up with cells containing multiple pieces of unordered data.

What happens when you need a part becomes 'incompatible' with a car/model or vice versa?

(I know that doesn't sound right but hopefully you'll get what I mean. )

Do you redo the whole thing or somehow delete the particular piece of data?

Also sorting/counting etc aren't going to be straightforward.

If you were doing this in a database one approach would be to have 3 tables/worksheets.

The two you already have and another for the 'compatibility'.

 

[notty dread]

Thanks for your suggestion Norrie, most of these parts do not change in the compatability with different models of cars, however if one does, then it's just a case of finding the product ID (Ctrl + f) on the ProdDatabase sheet and then editing the description to remove the incompatible cars/engines).

This form is just a way of making the data input easier in the descriptions, there is another macro that outputs the whole lot to a csv file, so it can be uploaded to a shop website.

It doesn't really matter about if the compatability information is ordered or not, as it is just added to the description so that it will be picked up by the web-shops search engine (the items are also categorised in the shop by the car type - but I wanted the other comaptible models in the desricption as this is what the search engine checks when a customer does a standard text search).

Thanks.

 

[Andrew Poulsom]

I made some amendments:

'UserForm module
Private Sub UserForm_Initialize()
    Dim Sh As Worksheet
    Dim Rng As Range
    Set Sh = Worksheets("ProdLists")
    With Sh
        Set Rng = .Range("H2:H" & .Range("H" & .Rows.Count).End(xlUp).Row)
    End With
    ComboBox1.List = Rng.Value
    With ListBox1
        .AddItem "1.2ltr"
        .AddItem "1.4ltr"
        .AddItem "1.6ltr"
        .AddItem "1.8ltr"
        .AddItem "2.0ltr"
        .AddItem "2.4ltr"
        .MultiSelect = fmMultiSelectExtended
    End With
    CommandButton1.Caption = "OK"
    CommandButton2.Caption = "Cancel"
End Sub
 
Private Sub CommandButton1_Click()
    Dim i As Integer
    With ActiveCell
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                If .Value = "" Then
                    .Value = ComboBox1.Value & " " & ListBox1.List(i)
                Else
                    .Value = .Value & ", " & ComboBox1.Value & " " & ListBox1.List(i)
                End If
            End If
        Next i
    End With
End Sub
Private Sub ComboBox1_Change()
    Dim i As Integer
    With ListBox1
        For i = 0 To .ListCount - 1
            .Selected(i) = False
        Next i
    End With
End Sub
 
Private Sub CommandButton2_Click()
    Unload Me
End Sub

'General module
Sub Test()
    If ActiveCell.Column <> 2 Then
        MsgBox "Please select a cell in column B"
        Exit Sub
    End If
    UserForm1.Show
End Sub