Userform med en label, en tekstboks og to knapper:
Kode
Option Explicit
Dim MyArray() As Variant
Dim NewArray() As Variant
Private Sub CbLuk_Click()
Unload uSøg 'Usøg er Userform.Name
End Sub
Private Sub TxtSøg_Exit(ByVal Cancel As MSForms.ReturnBoolean)
ReDim NewArray(LBound(MyArray, 1) To UBound(MyArray, 1), LBound(MyArray, 2) To UBound(MyArray, 2))
Dim R As Long, C As Long, iCount As Integer
Dim lCount As Long: lCount = 2
Dim ws As Worksheet: Set ws = Sheets("Søge Output")
Dim rArea As Range: Set rArea = ws.Range("A1")
If TxtSøg.Value = "" Then GoTo Videre
For R = 1 To UBound(MyArray, 1) ' 1. array dimension er rækker.
For C = 1 To UBound(MyArray, 2) ' 2. array dimension er kolonner.
If R = 1 Then
NewArray(R, C) = MyArray(R, C)
Else
If C = 2 Then 'Kolonne der skal tjekkes
If MyArray(R, C) Like "*" & UCase(TxtSøg.Value) & "*" Then ' gør det skrevne til storebogstaver og sætte joker foran og bag
For iCount = 1 To UBound(MyArray, 2)
NewArray(lCount, iCount) = MyArray(R, iCount)
Next
lCount = lCount + 1
End If
End If
End If
Next C
Next R
Set rArea = rArea.Resize(UBound(NewArray, 1), UBound(NewArray, 2))
rArea.Value = NewArray ' retunerer facit til retur ark
Videre:
Erase NewArray
End Sub
Private Sub UserForm_Initialize()
Dim wsData As Worksheet: Set wsData = Sheets("Data")
Dim rData As Range, lColumn As Long, lRow As Long
lColumn = wsData.Cells(1, Columns.Count).End(xlToLeft).Column
lRow = wsData.Cells(Rows.Count, 1).End(xlUp).Row
Set rData = wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRow, lColumn))
' tilpasser Controls på Userformen
With LbSøg ' Label
.Caption = "Søg:"
With .Font
.Size = 16
End With
.AutoSize = True
.Left = 5
.Top = 10
End With
With TxtSøg 'Tekstboks
With .Font
.Size = 12
End With
.Left = LbSøg.Width + LbSøg.Left * 2
.Height = 20
.Top = LbSøg.Top + 1
End With
With CbOk ' ok knap - Usynlig da den ikke blev nødvendig, må ikke fjernes, da luk knap bruge placeringen
.Left = LbSøg.Left + TxtSøg.Left + TxtSøg.Width
.Top = LbSøg.Top
.Height = TxtSøg.Height
.Visible = False
End With
With CbLuk 'Luk knap
.Left = LbSøg.Left + TxtSøg.Left + TxtSøg.Width
.Top = CbOk.Top + CbOk.Height + 5
End With
' tilpasser størrelsen på Userformen
With uSøg ' Userform
.Width = CbLuk.Left + CbLuk.Width + 20
.Height = CbLuk.Top + CbLuk.Height * 2 + 10
End With
' indlæser arket i et array
MyArray() = rData.Value
End Sub
Jan