Excel creating autofilling form - forms

Question

I'm trying to create a form which contains two entries:
-folder number
-list of toms which are in folders
This is for archiving purpose. Form is divided on 4 section which will be printed on labels for archive boxes.
Folders are numbered from 1 to 1500, some of them contain 1 tom of documents, some of them up to 10. For now I'm doing this manualy by just copying from the table which looks like this:
table
Only thing I need in form is TOM NUMBER from this table
form
I was trying to use VLOOKUP but it only returns first row which has searched folder number.
So bascially I want a function which will take folder number from label form and find all toms which are assigned to and write it below. first 3 digits in folder number aren't important, only last 4 digits are considered most important variable

Answer 1

Unfortunately vlookup will not work, you are going to have to use an array folder. I am making an assumption that you will have a table that is called [Folders]
and I am going to create a form form with some vba on how to do this.
1. Create a Table by selecting the folder dataset and push ctl+T.
Alt + F11 to enter Visual basic editor
At the top choose insert ==> UserForm
Push F4 and in the properties window name your form FileFinder
Your toolbox maynot appear if it doesn't choose view => toolbox to open
drag 2 labels, 2 listboxes, and 2 buttons, you can format it however you like.
7.Create a new Module same as adding userform only choose module
Copy paste this code
Public Function CreateWorksheet(Optional name As String = "") As Worksheet
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add
If name <> "" Then ws.name = name
Set Create = ws
End Function
Public Function LastRow() As Integer 'gets last row from column A
LastRow = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row
End Function
Public Function DistintFolders() As String()
Dim list() As String
Dim counter As Integer
For Each cell In ActiveSheet.Range("E2:E" & LastRow)
If Not IsInList(list, cell.Value, counter) Then
counter = counter + 1
ReDim Preserve list(1 To counter)
list(counter) = cell.Value
End If
Next cell
DistintFolders = list
End Function
Public Function TomNumberByFolder(folderName As Variant) As String()
Dim list() As String
Dim counter As Integer
Dim rowNumber As Integer
For Each cell In ActiveSheet.Range("B2:B" & LastRow)
rowNumber = rowNumber + 1
If IsCorrectFolder(folderName, rowNumber) Then
counter = counter + 1
ReDim Preserve list(1 To counter)
list(counter) = cell.Value
End If
Next cell
TomNumberByFolder = list
End Function
Public Function IsInList(ByRef list() As String, compare As String, count As Integer) As Boolean
Dim l As Variant
If compare = "" Then
IsInList = True
Exit Function
End If
If count = 0 Then
IsInList = False
Exit Function
End If
For Each l In list
If l = compare Then
IsInList = True
Exit Function
End If
Next l
IsInList = False
End Function
Public Function IsCorrectFolder(folderName As Variant, rowNumber As Integer) As Boolean
IsCorrectFolder = (ActiveSheet.Range("E" & rowNumber).Value = folderName)
End Function
double click your form and paste this code
`
Private Sub btnCancel_Click()
Unload Me
End Sub
Private Sub btnCreate_Click()
Dim ws As Worksheet
If lstTom.ListCount = 0 Then
MessageBox "Please select a folder"
End If
Set ws = ThisWorkbook.Sheets.Add
ws.Cells(1, 1).Value = "Tom Number"
ws.Cells(2, 1).Resize(Me.lstTom.ListCount, 1) = Me.lstTom.list
End Sub
Private Sub lstFolder_Click()
Dim folder As String
If ActiveSheet.name <> "Data" Then ThisWorkbook.Sheets("Data").Activate 'please name this whatever your datasheet is called
For i = 0 To lstFolder.ListCount - 1
If lstFolder.Selected(i) Then
Me.lstTom.Clear
For Each s In TomNumberByFolder(lstFolder.list(i))
With lstTom
.AddItem s
End With
Next s
End If
Next i
End Sub
Private Sub UserForm_Initialize()
For Each s In DistintFolders
With lstFolder
.AddItem s
End With
Next s
End Sub
`
please note that you may have to change sheet names if you would like I will send you this.
Download Here