Solved: combobox on the fly

[hardlife]

Hi, me put together this piece of code,

but me is really not happy it is probably not profesionally

this code is probably more complicated because me is not good

with array usage, especially more than one.

me knows You have a lot of work but does somebody

can comment my code ?

me is wishing everyone to have a good day, Pavel

[hardlife]

Please, does somebody know,
if there is better way to work with this two dimensional array?

[VBA]

' Use the Control Tools Combobox on the worksheet.

'never use the forms controls on the fly I agree with mdmackillop...

'this has is draw backs but you can get the hang of it quickly.
'the key here is that you can FORMAT the cells any way you like and control
'the font size without a massive add-in.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim isect As Range

If Target.Cells.Count > 1 Or Target.Column <> 3 Then Exit Sub

SearchWord = Range("A" & Target.row).Value
'MsgBox SearchWord

Set WordAddress = Sheets("customer+price").Cells.Find(What:=SearchWord, After:=[a1], LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If WordAddress Is Nothing Then
MsgBox ActiveWorkbook.Name & Chr(13) & "sheet: " & Sheets("customer+price").Name & Chr(13) _
& "product: " & SearchWord & Chr(13) & "Search string not found"
Z = "NOT"
GoTo NOTFOUND
Else:
Z = "YES"
Addresa = "row: " & WordAddress.row & " - address: " & WordAddress.Address
actualrow = WordAddress.row
'MsgBox "row = " & WordAddress.row
'MsgBox ActiveWorkbook.Name & Chr(13) & Sheets("customer+price").Name & Chr(13) & Addresa
End If


Dim myArray1 As Variant
Dim myArray2 As Variant
Dim myArray3() As String
Dim oCount As Long
Dim cellNEW As Range
Dim cellNEWValues() As Variant
Dim cellNEWValues2() As Variant
Dim IIIII As Integer
For Each cellNEW In Sheets("customer+price").Range("B1:M1") 'Selection
If cellNEW.Value <> "" And cellNEW.offset(actualrow - 1, 0).Value <> "" Then '-1 two place 1/2
'Increase the array by one and keep values
IIIII = IIIII + 1
ReDim Preserve cellNEWValues(0 To IIIII)
ReDim Preserve cellNEWValues2(0 To IIIII)
'Assign the current cellNEW's value to the new element
cellNEWValues(IIIII) = cellNEW.Value
cellNEWValues2(IIIII) = " = " & cellNEW.offset(actualrow - 1, 0).Value '-1 two place 2/2
End If
Next cellNEW

If Z = "YES" Then

myArray1 = cellNEWValues
myArray2 = cellNEWValues2

oCount = UBound(myArray1)
ReDim myArray3(oCount, 1)
For IIII = 0 To UBound(myArray1)
myArray3(IIII, 0) = myArray1(IIII)
Next IIII
For IIII = 0 To UBound(myArray2)
myArray3(IIII, 1) = myArray2(IIII)
Next IIII


Else
NOTFOUND:
ReDim myArray3(0, 1)
myArray3(0, 0) = ("NOT FOUND")
Target.Value = "NOT FOUND" '.Address
End If

LastCol = Sheets("customer+price").UsedRange.Columns.Count

Set isect = Application.Intersect(Range("ComboRng"), Target)

If Not isect Is Nothing Then

With ComboBox1
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width
.Height = Target.Height
.ColumnCount = 2

.List = myArray3

.LinkedCell = Target.Address

End With

ElseIf ComboBox1.Visible Then ComboBox1.Visible = False

End If

'MsgBox Target.Row

End Sub


'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
Private Sub ComboBox1_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Select Case KeyCode
Case 9 'Tab
ActiveCell.offset(0, 1).Activate
Case 13 'Enter
ActiveCell.offset(1, 0).Activate
Case Else
'do nothing
End Select
End Sub

[/VBA]

happy and sunny day, Pavel

[Bob Phillips]

What is it supposed to do?

[hardlife]

Hi, it is supposed to do:

01/ to create combobox on the fly,

02/ to find product = value in column A (on the same row)
02/ to find only producer with price for this product and show this
producers in combobox, to show in first column producer name
+ price in second column (price only for information) best would be
to sort by price, but this is not so much important (it is probably
big trouble in this two dimensional array) matrix with product,
customer name and price is in second worksheet,

03/ to put selected producer from combobox to target

04/ there is example workbook in attachment, You can see last attachment.

HAPPY AND SUNNY DAY, With Best Regards, Pavel

[mdmackillop]

This uses the MultiColumn property of the listbox. BTW, always use Option Explicit.

[vba]

Option Explicit
Option Base 1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim isect As Range
Dim c As Range
Dim Arr()
Dim SearchWord
Dim i%, j%

If Target.Cells.Count > 1 Or Target.Column <> 3 Then Exit Sub
SearchWord = Range("A" & Target.Row).Value
'MsgBox SearchWord
Set c = Sheets("customer+price").Cells.Find(What:=SearchWord, After:=[a1], LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If c Is Nothing Then
MsgBox ActiveWorkbook.Name & Chr(13) & "sheet: " & Sheets("customer+price").Name & Chr(13) _
& "product: " & SearchWord & Chr(13) & "Search string not found"
Else
ReDim Arr(2, 20)
With Sheets("customer+price")
For i = 1 To 20
If c.Offset(, i) <> "" Then
j = j + 1
Arr(1, j) = .Cells(1, i + 1)
Arr(2, j) = .Cells(c.Row, i + 1)
End If
Next
ReDim Preserve Arr(2, j)
End With

Set isect = Application.Intersect(Range("ComboRng"), Target)

If Not isect Is Nothing Then

With ComboBox1
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width
.Height = Target.Height
.ColumnCount = 2
.BoundColumn = 1
.ColumnWidths = 150 & ";" & 20
.List = Application.Transpose(Arr)
.LinkedCell = Target.Address
End With

ElseIf ComboBox1.Visible Then ComboBox1.Visible = False

End If
End If


End Sub
[/vba]

[hardlife]

Dear mdmackillop
Thank You a lot for Your help, me is very happy to see, it is possible to do the same not with 80 lines of code but with 40 lines
It was not easy for me to understand array, with Your help me can understand better, how does multiple dimensional array works

me is wishing You, all The Best, Good Luck and Sunny Days,
to You and all good world arround us, Pavel Humenuk