encode textbox values to specific cells based on

halshion

New Member
Joined
Jan 9, 2023
Messages
16
Office Version
  1. 2013
Platform
  1. Windows
Greetings everyone.

I would like to request a bit of help here. I want to encode textbox values input from Sample 1 to Sample 5, based on the value of "Date Encode" and "Time 24 Hour" combobox by linking the combobox values to the values on specific cells. Kindly see

1673484413478.png


The code below is only for subroutine "OK button", it can only encode texbox values to defined cells, with no conditions. I'll provide any info if you need more.

VBA Code:
Private Sub OKButton_Click()

'activate and submit data
Dim wb As Workbook
Dim findrange As Range
Set wb = Workbooks(Machine1.Value & ".xlsx")
wb.Activate
    
    With wb.Sheets(Me.DimensionBox1.Text)
     
        If Len(Data1.Text) > 0 Then .Range("AP16").Value = Data1.Value
        If Len(Data2.Text) > 0 Then .Range("AQ16").Value = Data2.Value
        If Len(Data3.Text) > 0 Then .Range("AR16").Value = Data3.Value
        If Len(Data4.Text) > 0 Then .Range("AS16").Value = Data4.Value
        If Len(Data5.Text) > 0 Then .Range("AT16").Value = Data5.Value
        
    End With
    
wb.Activate
'make workbook visible from machine1_change invisibility
result = MsgBox("Is this ok?", vbOKCancel + vbQuestion)
If result = vbOK Then
wb.Windows(1).Visible = True
wb.Save
wb.Close

    'clears textboxes after saving and exit
    DateEncode.Clear
    Time24hour = ""
    DateEncode = ""
    DimensionBox1 = ""
    Dim ctl As Control
        For Each ctl In Me.Controls
            If TypeOf ctl Is MSForms.TextBox Then
                ctl.Text = ""
            End If
        Next ctl
    
Else: MsgBox "Check if all values are correct", vbExclamation
End If
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
You didn't put how you loaded the combos. I also do not see in your image the name of the sheet or the cells where you are going to put the data.
It would be better if you share your file.

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
Greetings

Here is my gdrive link: Google Drive: Sign-in

Included the file where the userform values are transferred, just change the directory path on subroutine "Machine1".
Please take note that majority of the codes are sourced from the net, i only modified to suit my needs. Thank you very much for the assistance.
 
Upvote 0
Greetings,

I've hit a wall, still haven't figured it out though, I've come across some For-Each examples. Been trying to do multiple nested For-Each if possible
Kindly correct me please. Please take note that I just patched up different codes from different source, please bear with me

VBA Code:
Private Sub OKButton_Click()

'activate and submit data
Dim wb As Workbook
Dim ws As Worksheet
Dim dColumnRng As Range, sRowRng As Range, tColumnRng As Range, dcell As Range, tcell As Range

    Workbooks(Machine1.Value & ".xlsx").Activate
    
Set wb = Workbooks(Machine1.Value & ".xlsx")
    
    With wb.Sheets(Me.DimensionBox1.Text)
        Set dColumnRng = .Range("AN3:AN123")
        Set sRowRng = .Range("AP2:AT2")
        Set tColumnRng = .Range("AO3:AO123")

        For Each dcell In dColumnRng 'loop through column AN "Date Encode" cells
        
        'try finding corresponding text from Date Encode combobox in Column AN
            Set dColRngFnd = dColumnRng.Find(what:=DateEncode.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not dColRngFnd Is Nothing Then
                
        'find "Time 24 hour" combobox value in Column AO if Date found
                    For Each tcell In tColumnRng
                        Set tColRngFnd = tColumnRng.Find(what:=Time24hour.Value, LookIn:=xlValues, lookat:=xlWhole)
                            If Not tColRngFnd Is Nothing Then
                            
        'code test if my logic works LOL
                                MsgBox ("program is working")
                    Next tcell
        Next dcell
    End With
    
wb.Activate
'make workbook visible from machine1_change invisibility
result = MsgBox("Is this ok?", vbOKCancel + vbQuestion)
If result = vbOK Then
wb.Windows(1).Visible = True
wb.Save
wb.Close

    'clears textboxes after saving and exit
    DateEncode.Clear
    Time24hour = ""
    DateEncode = ""
    DimensionBox1 = ""
    Dim ctl As Control
        For Each ctl In Me.Controls
            If TypeOf ctl Is MSForms.TextBox Then
                ctl.Text = ""
            End If
        Next ctl
    
Else: MsgBox "Check if all values are correct", vbExclamation
End If
End Sub

The Date Encode combobox is populated using the OKButtonFirst_Click:

VBA Code:
Private Sub OKButtonFirst_Click()

Dim wb As Workbook
Dim datecell As Range
Dim Lastrow As Long
    
Set wb = Workbooks(Machine1.Value & ".xlsx") 'set file target as variable
        wb.Activate 'activate specific workbook opened

With wb.Sheets(Me.DimensionBox1.Text) 'inputs user form input into selected worksheet
    'populates the date encode combo box
    Lastrow = .Cells(.Rows.Count, "AN").End(xlUp).Row
    
    For Each datecell In .Range("AN3:AN123" & Lastrow)
        If datecell.Value <> "" Then 'ignores blank cells
            Me.DateEncode.AddItem datecell.Value
        End If
    Next
End With

End Sub

While the Time 24 hour combobox is populated at Userform_Initialize since this remains constant:

VBA Code:
Private Sub Userform_Initialize()
 
'empty dimension
DimensionBox1.Clear
    
'Empty YYMMDD
DateFrom.Value = ""
DateTo.Value = ""

'Empty Machine1
Machine1 = ""

'Fill Machine1
With Machine1
    .AddItem "Line 1 B39"
    .AddItem "Line 2 F6 new"
    .AddItem "Line 3 F7"
    .AddItem "Line 4 F8"
    .AddItem "Line 5 B48"
    .AddItem "Line 6 B49"
    .AddItem "Line 7 B51"
    .AddItem "Line 8 B50"
    .AddItem "Line 9 B28"
    .AddItem "Line 10 B45"
    .AddItem "Line 11 B41"
    .AddItem "Line 12 B38"
End With

'Empty Time24hour
Time24hour.Clear

'Fill Time24hour
With Time24hour
    .AddItem "0600"
    .AddItem "1200"
    .AddItem "1800"
    .AddItem "2400"
End With

'Empty Data 1
Data1.Value = ""

'Empty Data 2
Data2.Value = ""

'Empty Data 3
Data3.Value = ""

'Empty Data 4
Data4.Value = ""

'Empty Data 5
Data5.Value = ""

End Sub
 
Upvote 0
Edit:
Greetings,

I've hit a wall, still haven't figured it out though, I've come across some For-Each examples. Been trying to do multiple nested For-Each if possible
Kindly correct me please. Please take note that I just patched up different codes from different source, please bear with me

VBA Code:
Private Sub OKButton_Click()

'activate and submit data
Dim wb As Workbook
Dim ws As Worksheet
Dim dColumnRng As Range, sRowRng As Range, tColumnRng As Range, dcell As Range, tcell As Range

    Workbooks(Machine1.Value & ".xlsx").Activate
   
Set wb = Workbooks(Machine1.Value & ".xlsx")
   
    With wb.Sheets(Me.DimensionBox1.Text)
        Set dColumnRng = .Range("AN3:AN123")
        Set sRowRng = .Range("AP2:AT2")
        Set tColumnRng = .Range("AO3:AO123")

        For Each dcell In dColumnRng 'loop through column AN "Date Encode" cells
       
        'try finding corresponding text from Date Encode combobox in Column AN
            Set dColRngFnd = dColumnRng.Find(what:=DateEncode.Value, LookIn:=xlValues, lookat:=xlWhole)
                If Not dColRngFnd Is Nothing Then
               
        'find "Time 24 hour" combobox value in Column AO if Date found
                    For Each tcell In tColumnRng
                        Set tColRngFnd = tColumnRng.Find(what:=Time24hour.Value, LookIn:=xlValues, lookat:=xlWhole)
                            If Not tColRngFnd Is Nothing Then
                           
        'code test if my logic works LOL
                                MsgBox ("program is working")
                    Next tcell
        Next dcell
    End With
   
wb.Activate
'make workbook visible from machine1_change invisibility
result = MsgBox("Is this ok?", vbOKCancel + vbQuestion)
If result = vbOK Then
wb.Windows(1).Visible = True
wb.Save
wb.Close

    'clears textboxes after saving and exit
    DateEncode.Clear
    Time24hour = ""
    DateEncode = ""
    DimensionBox1 = ""
    Dim ctl As Control
        For Each ctl In Me.Controls
            If TypeOf ctl Is MSForms.TextBox Then
                ctl.Text = ""
            End If
        Next ctl
   
Else: MsgBox "Check if all values are correct", vbExclamation
End If
End Sub

The Date Encode combobox is populated using the OKButtonFirst_Click:

VBA Code:
Private Sub OKButtonFirst_Click()

Dim wb As Workbook
Dim datecell As Range
Dim Lastrow As Long
   
Set wb = Workbooks(Machine1.Value & ".xlsx") 'set file target as variable
        wb.Activate 'activate specific workbook opened

With wb.Sheets(Me.DimensionBox1.Text) 'inputs user form input into selected worksheet
    'populates the date encode combo box
    Lastrow = .Cells(.Rows.Count, "AN").End(xlUp).Row
   
    For Each datecell In .Range("AN3:AN123" & Lastrow)
        If datecell.Value <> "" Then 'ignores blank cells
            Me.DateEncode.AddItem datecell.Value
        End If
    Next
End With

End Sub

While the Time 24 hour combobox is populated at Userform_Initialize since this remains constant:

VBA Code:
Private Sub Userform_Initialize()
 
'empty dimension
DimensionBox1.Clear
   
'Empty YYMMDD
DateFrom.Value = ""
DateTo.Value = ""

'Empty Machine1
Machine1 = ""

'Fill Machine1
With Machine1
    .AddItem "Line 1 B39"
    .AddItem "Line 2 F6 new"
    .AddItem "Line 3 F7"
    .AddItem "Line 4 F8"
    .AddItem "Line 5 B48"
    .AddItem "Line 6 B49"
    .AddItem "Line 7 B51"
    .AddItem "Line 8 B50"
    .AddItem "Line 9 B28"
    .AddItem "Line 10 B45"
    .AddItem "Line 11 B41"
    .AddItem "Line 12 B38"
End With

'Empty Time24hour
Time24hour.Clear

'Fill Time24hour
With Time24hour
    .AddItem "0600"
    .AddItem "1200"
    .AddItem "1800"
    .AddItem "2400"
End With

'Empty Data 1
Data1.Value = ""

'Empty Data 2
Data2.Value = ""

'Empty Data 3
Data3.Value = ""

'Empty Data 4
Data4.Value = ""

'Empty Data 5
Data5.Value = ""

End Sub
Edit: Posted the wrong code regarding the Date Encode combobox population, I apologize:

VBA Code:
Private Sub OKButtonSecond_Click()

Dim wb As Workbook
Dim datStartDate As Date, datEndDate As Date
Dim lngStartDate As Long, lngEndDate As Long


Set wb = Workbooks(Machine1.Value & ".xlsx") 'set file target as variable
wb.Activate 'activate specific workbook opened
    With wb.Sheets(Me.DimensionBox1.Text) 'inputs user form input into selected worksheet
        
        'deletes previous date entry
        Range("AN3:AN123") = ""
        DateEncode.Clear
        
        'inserts values to range M4 and R4
        If Len(DateFrom.Text) > 0 Then .Range("M4").Value = CDate(DateFrom.Value)
        If Len(DateTo.Text) > 0 Then .Range("R4").Value = CDate(DateTo.Value)
    End With
    
datStartDate = wb.Sheets(Me.DimensionBox1.Text).Range("M4").Value
datEndDate = wb.Sheets(Me.DimensionBox1.Text).Range("R4").Value
    
lngStartDate = datStartDate
lngEndDate = datEndDate

Dim i As Date 'autofills date start to end using loop

    For i = 0 To (lngEndDate - lngStartDate)
        wb.Sheets(Me.DimensionBox1.Text).Cells(i + 3, 40).Offset(3 * i, 0) = lngStartDate + i
    Next i
    
    'populates combo box with date array enetered
With wb.Sheets(Me.DimensionBox1.Text)
       Lastrow = .Cells(.Rows.Count, "AN").End(xlUp).Row
    
    For Each datecell In .Range("AN3:AN123" & Lastrow)
        If datecell.Value <> "" Then 'ignores blank cells
            Me.DateEncode.AddItem datecell.Value
        End If
    Next
End With

End Sub
 
Upvote 0

Forum statistics

Threads
1,224,820
Messages
6,181,162
Members
453,021
Latest member
Justyna P

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