List(Sort by) Birthday Anniversaries in .txt file

willianrc

New Member
Joined
Jun 16, 2019
Messages
1
Hello people,
I'm having a problem here, I'd like to filter the birthdays in the listbox and also know the "|" symbols. from the list and keep only in the .txt database. I would also like the EDIT, DELETE buttons to work.
Follow the code so far and the download link. Thank you very much .

Code:
Option Explicit


Private Sub UserForm_Initialize()
    With ComboBox1
        .AddItem "01 - January"
        .AddItem "02 - February"
        .AddItem "03 - March"
        .AddItem "04 - April"
        .AddItem "05 - May"
        .AddItem "06 - June"
        .AddItem "07 - July"
        .AddItem "08 - August"
        .AddItem "09 - September"
        .AddItem "10 - October"
        .AddItem "11 - November"
        .AddItem "12 - Dezember"
    End With


    
Call Create_Folder
Call Load_Listbox
End Sub


Private Sub CommandButton1_Click()
    If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Then
        MsgBox "Enter all required fields", vbInformation, "Attention"
    Else
        WriteInfo VBA.Trim(TextBox1.Text) & "|" & VBA.Trim(TextBox2.Text) & "|" & VBA.Trim(TextBox3.Text)
Call Clean
End If
Call Load_Listbox
End Sub


Sub Clean()
    TextBox1.Text = ""
    TextBox2.Text = ""
    TextBox3.Text = ""
End Sub


Sub Load_Listbox() 'Enter all listbox users
Dim sTemp As String
Dim vrTemp As Variant


    ListBox1.Clear
    On Error Resume Next
    Dim LineofText As Variant
    Dim archivo As Variant
    ' Open the file for Input.
        Open ThisWorkbook.Path & "\REGISTER\users.txt" For Input As #1
            archivo = ThisWorkbook.Path & "\REGISTER\users.txt"
        If Dir(archivo) = "" Then
            MsgBox "FILE NOT FOUND. A 'REGISTRY' FOLDER HAS NOT BEEN SAME SAME OF THIS EXCEL FILE"
    
            Exit Sub
        End If
    Open archivo For Input As #1
    ' Read each line of the text file into a single string
    ' variable.
 
    Do While Not EOF(1)
    'Line Input #1, LineofText
    
        Line Input #1, LineofText
        
    ListBox1.AddItem LineofText
    
        vrTemp = Split(LineofText, "|")
    
    Loop
    ' Close the file.
    Close #1


End Sub


Private Sub ListBox1_Change()
    TextBox1.Text = ListBox1.List(ListBox1.ListIndex, 0)
    'TextBox2.Text = ListBox1.List(ListBox1.ListIndex, 1)
    'TextBox3.Text = ListBox1.List(ListBox1.ListIndex, 2)
End Sub


Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)


TextBox3.MaxLength = 10 '10/10/2017
 Select Case KeyAscii
      Case 8       'Aceita o BACK SPACE
      Case 13: SendKeys "{TAB}"    'Emula o TAB
      Case 48 To 57
         If TextBox3.SelStart = 2 Then TextBox3.SelText = "/"
         If TextBox3.SelStart = 5 Then TextBox3.SelText = "/"
      Case Else: KeyAscii = 0     'Ignore others caracters
   End Select
End Sub


Sub WriteInfo(LogMessage As String)


Dim LogFileName As String
Dim CheckFolder As String
Dim FileNum As Integer


    CheckFolder = ThisWorkbook.Path & "\REGISTER"
    'Set path and file name of log where you are? want to save
    'The log file
    
    LogFileName = CheckFolder & "\users.txt"   'filename to be saved'
    
    FileNum = FreeFile 'Next file number
    Open LogFileName For Append As #FileNum 'Create the file if it does not exist
    Print #FileNum, LogMessage 'Write information at the end of the text file
    Close #FileNum 'Close file


End Sub


Sub Create_Folder()
  Dim CheckFolder As String
        'Assign path to directory.
     CheckFolder = ThisWorkbook.Path & "\REGISTER"


       
      'Tests whether the directory exists. If it does not exist, the same is created.
        If Dir(CheckFolder, vbDirectory) = "" Then MkDir CheckFolder
             'cancela
        
End Sub

Link download: https://drive.google.com/file/d/1SSfCLQ8L8qk-l75u1POnJh38YafRJKob/view?usp=sharing
 
Last edited by a moderator:

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top