VBA - value is not pasting in master sheet

[shido]

Hi All,

I have userform to lookup for a value in "Database". If value found, then return values and paste into another sheet "IQuery". however, if value not found in "Database", then let the user to add empty fields.

After pressing add button, new data shall be saved in both sheet in the last available row. My VBA code is as follows. However i have attached a sample sheet for your test.

Private Sub cmdClose_Click()
'Close the userform
Unload Me
'http://www.onlinepclearning.com/excel-vba-userform-vlookup/
End Sub

Private Sub cmdSend_Click()
'Dim the variables
Dim cNum As Integer
Dim X As Integer
Dim nextrow As Range

'change the number for the number of controls on the userform
cNum = 6
Set nextrow = Worksheets("IQuery").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
For X = 1 To cNum
nextrow = Me.Controls("Reg" & X).Value
Set nextrow = nextrow.Offset(0, 1)
Next
MsgBox "The data has been sent"
'Clear the controls
cNum = 6
For X = 1 To cNum
Me.Controls("Reg" & X).Value = ""
Set nextrow = nextrow.Offset(0, 1)
Next
End Sub

Private Sub Reg1_AfterUpdate()
'Check to see if value exists
If WorksheetFunction.CountIf(Worksheets("Database").Range("A:A"), Me.Reg1.Value) = 0 Then
'MsgBox "This is an incorrect ID"

    Dim lastrow As Long
    lastrow = Sheets("Database").Range("a" & Rows.Count).End(xlUp).Row
    Sheets("Database").Activate
    
    Cells(lastrow + 1, "a").Value = Reg1
    Cells(lastrow + 1, "b").Value = Reg2
    Cells(lastrow + 1, "c").Value = Reg3
    Cells(lastrow + 1, "d").Value = Reg4
    Cells(lastrow + 1, "e").Value = Reg5
    Cells(lastrow + 1, "f").Value = Reg6
    
    Sheets("IQuery").Activate

Else
    
    With Me
    .Reg2 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 2, 0)
    .Reg3 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 3, 0)
    .Reg4 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 4, 0)
    .Reg5 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 5, 0)
    .Reg6 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 6, 0)
    End With

End If

End Sub

Issue i am facing is that new values are not adding in the "database", its only adding in one sheet. Can anyone help me to fix it please

Regards

Template-Vlookup-Userform-in-Code.xls

[jaslake]

Hi shido

Try this.

Private Sub cmdClose_Click()
   'Close the userform
   Unload Me
   'http://www.onlinepclearning.com/excel-vba-userform-vlookup/
End Sub

Private Sub cmdSend_Click()
   'Dim the variables
   Dim cNum         As Integer
   Dim X            As Integer
   Dim nextrow      As Range

   'change the number for the number of controls on the userform
   cNum = 6
   Set nextrow = Worksheets("IQuery").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
   For X = 1 To cNum
      nextrow = Me.Controls("Reg" & X).Value
      Set nextrow = nextrow.Offset(0, 1)
   Next

   With Sheets("Database")
      Dim lastrow   As Long
      lastrow = .Range("a" & .Rows.Count).End(xlUp).Row
      '      Sheets("Database").Activate

      .Cells(lastrow + 1, "a").Value = Reg1
      .Cells(lastrow + 1, "b").Value = Reg2
      .Cells(lastrow + 1, "c").Value = Reg3
      .Cells(lastrow + 1, "d").Value = Reg4
      .Cells(lastrow + 1, "e").Value = Reg5
      .Cells(lastrow + 1, "f").Value = Reg6
   End With
   MsgBox "The data has been sent"
   'Clear the controls
   cNum = 6
   For X = 1 To cNum
      Me.Controls("Reg" & X).Value = ""
      Set nextrow = nextrow.Offset(0, 1)
   Next
End Sub

'Private Sub Reg1_AfterUpdate()
'   'Check to see if value exists
'   If WorksheetFunction.CountIf(Worksheets("Database").Range("A:A"), Me.Reg1.Value) = 0 Then
'      'MsgBox "This is an incorrect ID"
'
'      Dim lastrow   As Long
'      lastrow = Sheets("Database").Range("a" & Rows.Count).End(xlUp).Row
'      Sheets("Database").Activate
'
'      Cells(lastrow + 1, "a").Value = Reg1
'      Cells(lastrow + 1, "b").Value = Reg2
'      Cells(lastrow + 1, "c").Value = Reg3
'      Cells(lastrow + 1, "d").Value = Reg4
'      Cells(lastrow + 1, "e").Value = Reg5
'      Cells(lastrow + 1, "f").Value = Reg6
'
'      Sheets("IQuery").Activate
'
'   Else
'
'      With Me
'         .Reg2 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 2, 0)
'         .Reg3 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 3, 0)
'         .Reg4 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 4, 0)
'         .Reg5 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 5, 0)
'         .Reg6 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 6, 0)
'      End With
'
'   End If
'
'End Sub

[shido]

Hi John,

Thanks for your time. Above code is only adding value in both sheets. I would also need to lookup ID in the "Database" and return the associated value if found.

Would you please mind if you fix above

1. lookup ID value in the "database" sheet, if found then paste it in the "IQuery" sheet.

2. if lookup ID is not found, then let the user add new data in "database" and "IQuery" sheet (as above)

Kind Regards,

[jaslake]

Hi shido

I think I see what you're trying to do...I'll look at it.

[jaslake]

Hi shido

You have multiple same ID's in Sheet IQuery (for example...1002, 1007, 1009). Why? What's the purpose of Sheet IQuery...to track changes?

I'd assume Sheet Database ID's should all be unique.

Please explain further what your end goal is.

[shido]

Great.. Thanks.. looking forward to it

[shido]

Hi John,

I am actually using "database" for saving my actual data. I am then using "userform" to lookup if value is existed in the "Database". if the value is existed in the "database" then return it in "IQuery".

I have separate VBA code which copy and clear IQuery rows and send it as email attachment. IQuery is used to save looked up values (can be multiple same IDs)

Lets say, purpose of this code is to searching data existing data, adding new data and send it to the user (separate VBA code, not included but works okay).

I hope i have answered your question.

[jaslake]

Hi shido

If I understand the issue, try this Code in the attached...

Private Sub cmdClose_Click()
   'Close the userform
   Unload Me
   'http://www.onlinepclearning.com/excel-vba-userform-vlookup/
End Sub

Private Sub cmdSend_Click()
   'Dim the variables
   Dim cNum         As Integer
   Dim X            As Integer
   Dim nextrow      As Range
   Dim lastrow      As Long

   'change the number for the number of controls on the userform
   cNum = 6
   Set nextrow = Worksheets("IQuery").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
   For X = 1 To cNum
      nextrow = Me.Controls("Reg" & X).Value
      Set nextrow = nextrow.Offset(0, 1)
   Next

   With Sheets("Database")
      If WorksheetFunction.CountIf(Worksheets("Database").Range("A:A"), Me.Reg1.Value) = 0 Then
         lastrow = .Range("a" & .Rows.Count).End(xlUp).Row
         .Cells(lastrow + 1, "a").Value = Reg1
         .Cells(lastrow + 1, "b").Value = Reg2
         .Cells(lastrow + 1, "c").Value = Reg3
         .Cells(lastrow + 1, "d").Value = Reg4
         .Cells(lastrow + 1, "e").Value = Reg5
         .Cells(lastrow + 1, "f").Value = Reg6
'      Else
      End If
   End With

   MsgBox "The data has been sent"
   'Clear the controls
   cNum = 6
   For X = 1 To cNum
      Me.Controls("Reg" & X).Value = ""
      Set nextrow = nextrow.Offset(0, 1)
   Next
End Sub

Private Sub Reg1_AfterUpdate()
   'Check to see if value exists
   If Not WorksheetFunction.CountIf(Worksheets("Database").Range("A:A"), Me.Reg1.Value) = 0 Then
      'MsgBox "This is an incorrect ID"

      Sheets("IQuery").Activate
      With Me
         .Reg2 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 2, 0)
         .Reg3 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 3, 0)
         .Reg4 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 4, 0)
         .Reg5 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 5, 0)
         .Reg6 = Application.WorksheetFunction.VLookup(CLng(Me.Reg1), Worksheets("Database").Range("Lookup"), 6, 0)
      End With
   End If
End Sub

[shido]

Its perfect. This is exactly what i wanted. However, a minor addition, if you please do not mind to look into it.

Database tab: Along with adding new data, I would also like to copy formatting from previous row and convert ID to number. Currently, it is saving ID as text as seen in the following pic

lookup.jpg

Regards,

[jaslake]

Hi shido

Replace the Command Button Click Code with this...

Private Sub cmdSend_Click()
   'Dim the variables
   Dim cNum         As Integer
   Dim X            As Integer
   Dim nextrow      As Range
   Dim lastrow      As Long

   'change the number for the number of controls on the userform
   cNum = 6
   Set nextrow = Worksheets("IQuery").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
   For X = 1 To cNum
      nextrow = Me.Controls("Reg" & X).Value
      Set nextrow = nextrow.Offset(0, 1)
   Next

   With Sheets("Database")
      If WorksheetFunction.CountIf(Worksheets("Database").Range("A:A"), Me.Reg1.Value) = 0 Then
         lastrow = .Range("a" & .Rows.Count).End(xlUp).Row
         .Range(.Cells(lastrow, "A"), .Cells(lastrow, "F")).Copy
         .Range(.Cells(lastrow + 1, "A"), .Cells(lastrow + 1, "F")).PasteSpecial (xlPasteFormats)
         Application.CutCopyMode = False
         .Cells(lastrow + 1, "a").Value = Format(Reg1, "0")
         .Cells(lastrow + 1, "b").Value = Reg2
         .Cells(lastrow + 1, "c").Value = Reg3
         .Cells(lastrow + 1, "d").Value = Reg4
         .Cells(lastrow + 1, "e").Value = Reg5
         .Cells(lastrow + 1, "f").Value = Format(Reg6, "0")
      End If
   End With

   MsgBox "The data has been sent"
   'Clear the controls
   cNum = 6
   For X = 1 To cNum
      Me.Controls("Reg" & X).Value = ""
      Set nextrow = nextrow.Offset(0, 1)
   Next
End Sub

[shido]

Perfect,

Thanks for your help John. i really appreciate your time.

[jaslake]

You're welcome...glad I could help. Thanks for the Rep.