<o:p></o:p>
Option Explicit<o:p></o:p>
<o:p> </o:p>
Const MAX_ROW = 2000<o:p></o:p>
Const MAX_COLUMN = 20<o:p></o:p>
Const DATA_START_ROW = 3<o:p></o:p>
<o:p> </o:p>
Dim nNoEmptyRow As Integer<o:p></o:p>
Dim xTitle(MAX_COLUMN) As String<o:p></o:p>
Dim xConditionColumn ' for all columns used in the form<o:p></o:p>
<o:p> </o:p>
Const START_ROW_NUMBER = 5 ' visningsark<o:p></o:p>
Dim bCheck As Boolean<o:p></o:p>
<o:p> </o:p>
' Show the second choice<o:p></o:p>
Private Sub cboItem1_Change()<o:p></o:p>
If bCheck = False Then Exit Sub<o:p></o:p>
Dim strTerm1 As String, dummy As String, I As Integer, K As Integer<o:p></o:p>
Dim bFound As Boolean<o:p></o:p>
strTerm1 = cboItem1.Text<o:p></o:p>
cboItem2.Clear<o:p></o:p>
For I = 0 To nNoEmptyRow - 1<o:p></o:p>
If (strTerm1 = xConditionColumn(I, 0)) Then<o:p></o:p>
dummy = xConditionColumn(I, 1)<o:p></o:p>
If dummy <> "" Then<o:p></o:p>
bFound = False<o:p></o:p>
For K = 0 To cboItem2.ListCount - 1<o:p></o:p>
If dummy = cboItem2.List(K) Then<o:p></o:p>
bFound = True<o:p></o:p>
Exit For<o:p></o:p>
End If<o:p></o:p>
Next K<o:p></o:p>
If bFound = False Then<o:p></o:p>
cboItem2.AddItem dummy<o:p></o:p>
If cboItem2.Text = "" Then cboItem2.Text = dummy<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
Next I<o:p></o:p>
End Sub<o:p></o:p>
<o:p> </o:p>
Private Sub cboItem2_Change()<o:p></o:p>
If bCheck = False Then Exit Sub<o:p></o:p>
Dim strTerm1 As String, strTerm2 As String<o:p></o:p>
Dim dummy As String, I As Integer, K As Integer<o:p></o:p>
Dim bFound As Boolean<o:p></o:p>
strTerm1 = cboItem1.Text<o:p></o:p>
strTerm2 = cboItem2.Text<o:p></o:p>
cboItem3.Clear<o:p></o:p>
For I = 0 To nNoEmptyRow - 1<o:p></o:p>
If (strTerm1 = xConditionColumn(I, 0)) And (strTerm2 = xConditionColumn(I, 1)) Then<o:p></o:p>
dummy = xConditionColumn(I, 2)<o:p></o:p>
If dummy <> "" Then<o:p></o:p>
bFound = False<o:p></o:p>
For K = 0 To cboItem3.ListCount - 1<o:p></o:p>
If dummy = cboItem3.List(K) Then<o:p></o:p>
bFound = True<o:p></o:p>
Exit For<o:p></o:p>
End If<o:p></o:p>
Next K<o:p></o:p>
If bFound = False Then<o:p></o:p>
cboItem3.AddItem dummy<o:p></o:p>
If cboItem3.Text = "" Then cboItem3.Text = dummy<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
Next I<o:p></o:p>
End Sub<o:p></o:p>
<o:p> </o:p>
Private Sub cboItem3_Change()<o:p></o:p>
If bCheck = False Then Exit Sub<o:p></o:p>
Dim strTerm1 As String, strTerm2 As String, strTerm3 As String<o:p></o:p>
Dim dummy As String, I As Integer, K As Integer<o:p></o:p>
Dim bFound As Boolean<o:p></o:p>
strTerm1 = cboItem1.Text<o:p></o:p>
strTerm2 = cboItem2.Text<o:p></o:p>
strTerm3 = cboItem3.Text<o:p></o:p>
cboItem4.Clear<o:p></o:p>
For I = 0 To nNoEmptyRow - 1<o:p></o:p>
If (strTerm1 = xConditionColumn(I, 0)) And (strTerm2 = xConditionColumn(I, 1)) And (strTerm3 = xConditionColumn(I, 2)) Then<o:p></o:p>
dummy = xConditionColumn(I, 3)<o:p></o:p>
If dummy <> "" Then<o:p></o:p>
bFound = False<o:p></o:p>
For K = 0 To cboItem4.ListCount - 1<o:p></o:p>
If dummy = cboItem4.List(K) Then<o:p></o:p>
bFound = True<o:p></o:p>
Exit For<o:p></o:p>
End If<o:p></o:p>
Next K<o:p></o:p>
If bFound = False Then<o:p></o:p>
cboItem4.AddItem dummy<o:p></o:p>
If cboItem4.Text = "" Then cboItem4.Text = dummy<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
Next I<o:p></o:p>
End Sub<o:p></o:p>
<o:p> </o:p>
Private Sub cboItem4_Change()<o:p></o:p>
If bCheck = False Then Exit Sub<o:p></o:p>
Dim strTerm1 As String, strTerm2 As String, strTerm3 As String, strTerm4 As String<o:p></o:p>
Dim dummy As String, I As Integer, K As Integer<o:p></o:p>
Dim bFound As Boolean<o:p></o:p>
strTerm1 = cboItem1.Text<o:p></o:p>
strTerm2 = cboItem2.Text<o:p></o:p>
strTerm3 = cboItem3.Text<o:p></o:p>
strTerm4 = cboItem4.Text<o:p></o:p>
lstMore.Clear<o:p></o:p>
For I = 0 To nNoEmptyRow - 1<o:p></o:p>
If (strTerm1 = xConditionColumn(I, 0)) And (strTerm2 = xConditionColumn(I, 1)) And (strTerm3 = xConditionColumn(I, 2)) And (strTerm4 = xConditionColumn(I, 3)) Then<o:p></o:p>
dummy = xConditionColumn(I, 4)<o:p></o:p>
If dummy <> "" Then<o:p></o:p>
bFound = False<o:p></o:p>
For K = 0 To lstMore.ListCount - 1<o:p></o:p>
If dummy = lstMore.List(K) Then<o:p></o:p>
bFound = True<o:p></o:p>
Exit For<o:p></o:p>
End If<o:p></o:p>
Next K<o:p></o:p>
If bFound = False Then<o:p></o:p>
lstMore.AddItem dummy<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
Next I<o:p></o:p>
End Sub<o:p></o:p>
<o:p> </o:p>
Private Sub cmdOK_Click()<o:p></o:p>
DisplayChoice<o:p></o:p>
Unload Me<o:p></o:p>
End Sub<o:p></o:p>
<o:p> </o:p>
Private Sub DisplayChoice()<o:p></o:p>
Dim I As Integer, J As Integer<o:p></o:p>
Dim v1 As String, v2 As String, v3 As String, v4 As String, v5 As String<o:p></o:p>
<o:p></o:p>
For J = 1 To MAX_COLUMN<o:p></o:p>
Cells(START_ROW_NUMBER - 1, J + 1) = xTitle(J)<o:p></o:p>
Next J<o:p></o:p>
<o:p> </o:p>
v1 = cboItem1.Text<o:p></o:p>
v2 = cboItem2.Text<o:p></o:p>
v3 = cboItem3.Text<o:p></o:p>
v4 = cboItem4.Text<o:p></o:p>
' här skriva logik för att visa rader som hittade
Dim iRow As Integer<o:p></o:p>
iRow = START_ROW_NUMBER<o:p></o:p>
For I = 0 To nNoEmptyRow<o:p></o:p>
If CStr(Sheets("Data").Cells(I + DATA_START_ROW, 2).Value) = v1 Then<o:p></o:p>
If CStr(Sheets("Data").Cells(I + DATA_START_ROW, 3).Value) = v2 Then<o:p></o:p>
If CStr(Sheets("Data").Cells(I + DATA_START_ROW, 4).Value) = v3 Then<o:p></o:p>
If CStr(Sheets("Data").Cells(I + DATA_START_ROW, 5).Value) = v4 Then<o:p></o:p>
For J = 0 To lstMore.ListCount - 1<o:p></o:p>
If lstMore.Selected(J) = True Then<o:p></o:p>
If CStr(Sheets("Data").Cells(I + DATA_START_ROW, 6).Value) = lstMore.List(J) Then<o:p></o:p>
DisplayFoundRow iRow, I + DATA_START_ROW<o:p></o:p>
iRow = iRow + 1<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
Next J<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
End If<o:p></o:p>
Next I<o:p></o:p>
End Sub<o:p></o:p>
Private Sub DisplayFoundRow(ByVal iRow As Integer, ByVal iOriginal As Integer)<o:p></o:p>
Dim J As Integer<o:p></o:p>
For J = 1 To MAX_COLUMN<o:p></o:p>
Cells(iRow, J) = Sheets("Data").Cells(iOriginal, J)<o:p></o:p>
Next J<o:p></o:p>
End Sub<o:p></o:p>
<o:p> </o:p>
' Initialize the form data<o:p></o:p>
Private Sub UserForm_Initialize()<o:p></o:p>
bCheck = False<o:p></o:p>
Dim I As Integer, J As Integer, dummy As String<o:p></o:p>
If (IsSheetExist("Main") = False) Then<o:p></o:p>
MsgBox "Det finns ingen data ark!"
Exit Sub<o:p></o:p>
End If<o:p></o:p>
<o:p></o:p>
lstMore.Clear<o:p></o:p>
cboItem1.Clear<o:p></o:p>
cboItem2.Clear<o:p></o:p>
cboItem3.Clear<o:p></o:p>
cboItem4.Clear<o:p></o:p>
'Sheets("Data").Select<o:p></o:p>
' fetch title<o:p></o:p>
For J = 1 To MAX_COLUMN<o:p></o:p>
xTitle(J - 1) = Sheets("Data").Cells(2, J)<o:p></o:p>
Next J<o:p></o:p>
lblItem1.Caption = xTitle(1)<o:p></o:p>
lblItem2.Caption = xTitle(2)<o:p></o:p>
lblItem3.Caption = xTitle(3)<o:p></o:p>
lblItem4.Caption = xTitle(4)<o:p></o:p>
lblItem5.Caption = xTitle(5)<o:p></o:p>
' Fetch all columns used in the dialog<o:p></o:p>
nNoEmptyRow = 0<o:p></o:p>
For I = DATA_START_ROW To MAX_ROW<o:p></o:p>
If Sheets("Data").Cells(I, 1) = "" Then Exit For<o:p></o:p>
nNoEmptyRow = nNoEmptyRow + 1<o:p></o:p>
Next I<o:p></o:p>
ReDim xConditionColumn(nNoEmptyRow, 5)<o:p></o:p>
For I = DATA_START_ROW To nNoEmptyRow<o:p></o:p>
xConditionColumn(I - DATA_START_ROW, 0) = CStr(Sheets("Data").Cells(I, 2).Value)<o:p></o:p>
xConditionColumn(I - DATA_START_ROW, 1) = CStr(Sheets("Data").Cells(I, 3).Value)<o:p></o:p>
xConditionColumn(I - DATA_START_ROW, 2) = CStr(Sheets("Data").Cells(I, 4).Value)<o:p></o:p>
xConditionColumn(I - DATA_START_ROW, 3) = CStr(Sheets("Data").Cells(I, 5).Value)<o:p></o:p>
xConditionColumn(I - DATA_START_ROW, 4) = CStr(Sheets("Data").Cells(I, 6).Value)<o:p></o:p>
Next I<o:p></o:p>
For I = 0 To nNoEmptyRow - 1<o:p></o:p>
dummy = CStr(Sheets("Data").Cells(I + DATA_START_ROW, 2).Value)<o:p></o:p>
If dummy <> "" Then Call AddComboCellIfNotExist(cboItem1, dummy)<o:p></o:p>
<o:p></o:p>
' dummy = CStr(Sheets("Data").Cells(I, 3).Value)<o:p></o:p>
' If dummy <> "" Then Call AddComboCellIfNotExist(cboItem2, dummy)<o:p></o:p>
<o:p> </o:p>
' dummy = CStr(Sheets("Data").Cells(I, 4).Value)<o:p></o:p>
' If dummy <> "" Then Call AddComboCellIfNotExist(cboItem3, dummy)<o:p></o:p>
<o:p> </o:p>
' dummy = CStr(Sheets("Data").Cells(I, 5))<o:p></o:p>
' If dummy <> "" Then Call AddComboCellIfNotExist(cboItem4, dummy)<o:p></o:p>
<o:p> </o:p>
' dummy = CStr(Sheets("Data").Cells(I, 6).Value)<o:p></o:p>
' If dummy <> "" Then<o:p></o:p>
'Call AddListCellIfNotExist(ListBox1, dummy)<o:p></o:p>
' Dim K As Integer, bFound As Boolean<o:p></o:p>
' bFound = False<o:p></o:p>
' For K = 0 To lstMore.ListCount - 1<o:p></o:p>
' If dummy = lstMore.List(K) Then<o:p></o:p>
' bFound = True<o:p></o:p>
' Exit For<o:p></o:p>
' End If<o:p></o:p>
' Next K<o:p></o:p>
' If bFound = False Then lstMore.AddItem dummy<o:p></o:p>
' End If<o:p></o:p>
Next I<o:p></o:p>
' cboItem1.Text = cboItem1.List(0)<o:p></o:p>
' cboItem2.Text = cboItem2.List(0)<o:p></o:p>
' cboItem3.Text = cboItem3.List(0)<o:p></o:p>
' cboItem4.Text = cboItem4.List(0)<o:p></o:p>
' lstMore.Selected(0) = True<o:p></o:p>
Sheets("Main").Select<o:p></o:p>
bCheck = True<o:p></o:p>
End Sub<o:p></o:p>
<o:p> </o:p>
Private Sub AddComboCellIfNotExist(ByRef obj1 As ComboBox, str As String)<o:p></o:p>
Dim I As Integer<o:p></o:p>
For I = 0 To obj1.ListCount - 1<o:p></o:p>
If str = obj1.List(I) Then<o:p></o:p>
Exit Sub<o:p></o:p>
End If<o:p></o:p>
Next I<o:p></o:p>
obj1.AddItem str<o:p></o:p>
End Sub<o:p></o:p>
<o:p> </o:p>
' check the existence of sheet, clear if found<o:p></o:p>
Private Function IsSheetExist(ByVal strSheetName As String) As Boolean<o:p></o:p>
On Error GoTo errHandle<o:p></o:p>
Sheets(strSheetName).Select<o:p></o:p>
Cells.Select<o:p></o:p>
Selection.ClearContents<o:p></o:p>
Cells(1, 1).Select<o:p></o:p>
IsSheetExist = True<o:p></o:p>
Exit Function<o:p></o:p>
errHandle:<o:p></o:p>
IsSheetExist = False<o:p></o:p>
End Function<o:p></o:p>