Hi all,
In 2,5 weeks i did solve the problem by my own and this whitout knowing
anything about VB, Excel or even what a combobox
was.....................................................................!!!!
Give an sample example of the code:
Option Explicit
Dim rListSort As Range, rOldList As Range
Dim strRowSource As String
Dim ComChoice 'Selected value in combobox
Dim Sel 'Button selection
Dim i&
Dim j&
Dim w&
Dim c&
Dim x&
Dim hCell 'Cell in sheet Hidden
Dim dCell 'Cell in sheet Data
Dim tCell 'Cell in sheet Hidden, used for check how many of same value
Private Sub ComboBox1_Change()
'Speed up things
Application.ScreenUpdating = False
Select Case Sel
Case 1 'First Name
ComChoice = Worksheets("Hidden").Range("$A$1").Value 'Read
the value of the linked cell
If ComChoice <> "" Then
'---------Clear sheet Search---------------------
i = 14
Do Until i > 130
Worksheets("Search").Cells(i, 1).EntireRow.Clear
i = i + 1
Loop
Worksheets("Search").Cells(12, 1).EntireRow.Clear
'Assign hCell the value of the selected choice in
combobox
hCell = ComChoice
j = 2 'Start on row 2 in sheet Data
'Step the rows (j) trough the column A in sheet Data to
find all
'cells with same value as selected in combobox, when
found,
'copy the row from sheet Data and insert it on sheet
Search.
c = 2
Do Until j > 120
'Assign dCell the value of the cell on row i and
column A in sheet Data
dCell = Worksheets("Data").Cells(j, 1).Value
If hCell = dCell Then
Worksheets("Data").Cells(j, 1).EntireRow.Copy
Worksheets("Search").Cells(12 + c,
1).EntireRow.Insert
c = c + 1
End If
j = j + 1
Loop
End If
End Select
End Sub
Private Sub FirstName_Click()
Sel = 1
'Speed up things
Application.ScreenUpdating = False
'---------Clear sheet
Search----------------------------------------------------
i = 14
Do Until i > 150
Worksheets("Search").Cells(i, 1).EntireRow.Clear
i = i + 1
Loop
Worksheets("Search").Cells(12, 1).EntireRow.Clear
Worksheets("Search").Cells(11, 1).EntireRow.Clear
Worksheets("Search").Range("$A$13").EntireRow.Delete
Worksheets("Data").Range("$A$1").EntireRow.Copy
Worksheets("Search").Range("$A$13").EntireRow.Insert
Worksheets("Search").Range("$A$13:$O$13").Interior.ColorIndex = 6
Worksheets("Search").Range("$Q$13").Interior.ColorIndex = 6
'---------Fix a sorted list of column A in sheet
Hidden-------------------------
'Clear cells A1-E1 down to row 200 in sheet Hidden
With Worksheets("Hidden")
..Range(.Cells(200, 1), .Cells(200, 15).End(xlUp)).Clear
End With
'Set range variable to list we want
Set rOldList = Worksheets("Data").Range("A2",
Worksheets("Data").Range("A65536").End(xlUp))
'Use AdvancedFilter to copy the list to column A of the sheet
Hidden
rOldList.AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Worksheets("Hidden").Cells(2, 1), Unique:=False
'Set range variable to the new list
Set rListSort = Worksheets("Hidden").Range("A2",
Worksheets("Hidden").Range("A65536").End(xlUp))
With rListSort
'Sort the new list
..Sort Key1:=Worksheets("Hidden").Cells(2, 1),
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
End With
'Parse the address of the sorted unique items
strRowSource = Worksheets("Hidden").Name & "!" &
Worksheets("Hidden").Range("A1",
Worksheets("Hidden").Range("A65536").End(xlUp)).Address
With Worksheets("Search").ComboBox1
ComboBox1.ListFillRange = strRowSource
ComboBox1.ListIndex = 0
End With
'-----------------------------------------------------------------------------
w = 0 'Number of equal values in column A in sheet Hidden
i = 2 'Start on row 2 in sheet Hidden
'Step the rows (i) through the column A in sheet hidden
Do Until i > 120
'Assign hCell the value of the cell on row i and column A in
sheet Hidden
hCell = Worksheets("Hidden").Cells(i, 1).Value
x = 0 'Reset x
'Check how many equal values in column A in sheet Hidden,
'set the number of equals as (w), step the rows with (x)
If w = 0 Then
Do Until (i + x) > 120
x = x + 1
tCell = Worksheets("Hidden").Cells(i + x, 1).Value
If hCell = tCell Then
w = w + 1
End If
Loop
End If
j = 2 'Start on row 2 in sheet Data
c = 0 'Step the rows with (c) in sheet Search if the cells in
'sheet Hidden contains same value
'Step the rows (j) trough the column A in sheet Data to find
all
'cells with same value as found in sheet Hidden, when found,
'copy the row from sheet Data and insert it on sheet Hidden.
'Check next cell in column A in sheet Data until all cells
found, w=0
Do Until j > 120
'Assign dCell the value of the cell on row i and column A
in sheet Data
dCell = Worksheets("Data").Cells(j, 1).Value
If hCell = dCell Then
c = c + 1
Worksheets("Data").Cells(j, 1).EntireRow.Copy
Worksheets("Search").Cells(i + 11 + c,
1).EntireRow.Insert
w = w - 1
If w = 0 Then
GoTo 0
End If
End If
j = j + 1
Loop
0
i = i + c
Loop
End Sub
Merry christmas and a Happy VB programming year!!!!!