Find empty cell in row, input value and repeat this x times

[kanadaaa]

Hi, I have a question about the code below (not sure if it actually works at all because I'm a beginner):

Private Sub CommandButton1_Click()
    Dim emptyRow As Long
    Dim rng As Range

    'Make Sheet1 active
    Sheet1.Activate

    'Determine emptyRow
    emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
    
    Cells(emptyRow, 1).Value = TextBox1.Value
    Set rng = Sheet2.Range("A").Find(TextBox1.Value, LookAt:=xlWhole)
    If rng Is Nothing Then
        MsgBox "No match"
    Else
        
        '// Search for the first empty cell in the row in which rng is located, and input the value of TextBox2 there
        '// Then, repeat this event TextBox1.Value-divided-by-4000 times (e.g. if the value is 8000 repeat the event twice)
        
    End If
    Unload Me
End Sub

I have a userform named UserForm1 and it has TextBox1, TextBox2, TextBox3 and CommandButton1 on it.
TextBox1 carries the name of a person, TextBox2 the value of an 8-digit date, and TextBox3 a numeral.
What I want to do is, when CommandButton1 is clicked, find the first empty row in Column A on sheet1 and put the value of TextBox1 into the relevant cell.
Then check if there's the same value in Column A on Sheet2, and if there is, select the cell, and with this position as an anchor, search for the first empty cell in the row and put the value of TextBox2 into it.
I also want this to repeat TextBox3.Value-divided-by-4000 times (e.g. if the value is 8000 it's 8000/4000 and thus twice).
Let's say I have THIS on sheet2 and the following values for the objects:

TextBox1.Value = "John"
TextBox2.Value = "12302018"
TextBox3.Value = "12000"

A	B	C	D	E
John	01212018
Mary

Then, I want C1 to E1 to be filled with TextBox2.Value because TextBox3.Value is 12000.
If TextBox3.Value were 8000, I'd only want C1 and D1 to be filled.
Is it possible to do this with VBA? I can't do it on my own, so any help would be appreciated.

 

[DanteAmor]

Try this

Private Sub CommandButton1_Click()
  Dim lr As Long, f As Range, n As Double, col As Long

  'find the first empty row in Column A on sheet1 and put the value of TextBox1
  lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
  Sheet1.Range("A" & lr).Value = TextBox1.Value
  
  Set f = Sheet2.Range("A:A").Find(TextBox1.Value, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "No match"
  Else
    'put the value of TextBox2
    col = Sheet2.Cells(f.Row, Columns.Count).End(xlToLeft).Column + 1
    n = Int(Val(TextBox3.Value / 4000))
    Sheet2.Cells(f.Row, col).Value = TextBox2.Value
    Sheet2.Cells(f.Row, col + 1).Resize(1, n).Value = TextBox2.Value
  End If
  Unload Me
End Sub

 

[kanadaaa]

Thank you very much, Dante!
It worked as I wanted when I'd modified it slightly as:
(I changed the second argument of the Resize function.)

Private Sub CommandButton1_Click()
  Dim lr As Long, f As Range, n As Double, col As Long

  'find the first empty row in Column A on sheet1 and put the value of TextBox1
  lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
  Sheet1.Range("A" & lr).Value = TextBox1.Value
  
  Set f = Sheet2.Range("A:A").Find(TextBox1.Value, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "No match"
  Else
    'put the value of TextBox2
    col = Sheet2.Cells(f.Row, Columns.Count).End(xlToLeft).Column + 1
    n = Int(Val(TextBox3.Value) / 4000)
    Sheet2.Cells(f.Row, col).Value = TextBox2.Value
    Sheet2.Cells(f.Row, col + 1).Resize(1, n - 1).Value = TextBox2.Value
  End If
  Unload Me
End Sub

 

[kanadaaa]

Hi, I now want to add hyperlink to Sheet1.Range("A" & lr) that jumps to the matched cell searched for by the Find function.
I tried to do this on my own but I'm too new to VBA to realize this.
My naive attempt is as below, but I have no idea how I should specify the cell that the hyperlink jumps to (it doesn't work probably because I have something wrong with SubAddress).

Private Sub CommandButton1_Click()
  Dim lr As Long, f As Range, n As Double, col As Long

  'find the first empty row in Column A on sheet1 and put the value of TextBox1
  lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
  Sheet1.Range("A" & lr).Value = TextBox1.Value
  
  Set f = Sheet2.Range("A:A").Find(TextBox1.Value, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "No match"
  Else
     Sheet1.Hyperlinks.Add Anchor:=Range("A" & lr), Address:="", SubAddress:=f.Address
    'put the value of TextBox2
    col = Sheet2.Cells(f.Row, Columns.Count).End(xlToLeft).Column + 1
    n = Int(Val(TextBox3.Value) / 4000)
    Sheet2.Cells(f.Row, col).Value = TextBox2.Value
    Sheet2.Cells(f.Row, col + 1).Resize(1, n - 1).Value = TextBox2.Value
  End If
  Unload Me
End Sub

 

[kanadaaa]

I grappled with this for hours and reached the following code and managed to solve the issue.

Private Sub CommandButton1_Click()
  Dim lr As Long, f As Range, n As Double, col As Long

  'find the first empty row in Column A on sheet1 and put the value of TextBox1
  lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row + 1
  Sheet1.Range("A" & lr).Value = TextBox1.Value
  
  Set f = Sheet2.Range("A:A").Find(TextBox1.Value, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "No match"
  Else
    Sheet1.Hyperlinks.Add Anchor:=Range("A" & lr), Address:="", SubAddress:="Sheet2!" & f.Address
    'put the value of TextBox2
    col = Sheet2.Cells(f.Row, Columns.Count).End(xlToLeft).Column + 1
    n = Int(Val(TextBox3.Value) / 4000)
    Sheet2.Cells(f.Row, col).Value = TextBox2.Value
    Sheet2.Cells(f.Row, col + 1).Resize(1, n - 1).Value = TextBox2.Value
  End If
  Unload Me
End Sub

 

[DanteAmor]

I'm glad to know that you solved your problem. Thanks for sharing.