I was wondering if anyone can assist at all please.
I have created a userform within Excel and using a reference number it will return the values of the given row within a table. The issue I am currently receiving is when I initially open the workbook that the find function does not work and comes back with the Msgbox given in the code "ID does not exist".
However if I use the userform to create a new line within the table then after this the find function is working absolutely fine. Has anyone got any suggestions?
Private Sub Find_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
mysearch = Me.Search.Value
With ThisWorkbook.Sheets("Master Data")
Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
Me.RsnDc = foundCell.Offset(0, 4).Value
Me.BDM.Value = foundCell.Offset(0, 6).Value
Me.MIns.Value = foundCell.Offset(0, 7).Value
Me.EUs.Value = foundCell.Offset(0, 8).Value
Me.In.Value = foundCell.Offset(0, 9).Value
Me.Pr.Value = foundCell.Offset(0, 10).Value
Me.Qu.Value = foundCell.Offset(0, 11).Value
Me.ReCd.Value = foundCell.Offset(0, 12).Value
Me.ReOrCd.Value = foundCell.Offset(0, 13).Value
Me.Ttl.Value = foundCell.Offset(0, 5).Value
Me.Va.Value = Me.Total.Value / 1.2
Me.VT.Value = Me.Total.Value - Me.Value.Value
Me.R.Value = foundCell.Offset(0, 17).Value
Me.App.Value = foundCell.Offset(0, 18).Value
Me.L1.Value = foundCell.Offset(0, 19).Value
Me.L2.Value = foundCell.Offset(0, 20).Value
Me.CY.Value = foundCell.Offset(0, 21).Value
Me.PC.Value = foundCell.Offset(0, 22).Value
Me.SN1.Value = Left(foundCell.Offset(0, 23).Value, 2)
Me.SN2.Value = Mid(foundCell.Offset(0, 23).Value, 3, 2)
Me.SN3.Value = Right(foundCell.Offset(0, 23).Value, 2)
Me.ANCT.Value = foundCell.Offset(0, 24).Value
Else
MsgBox "ID does not exist."
End If
End Sub
I commented out all of the other text boxes and removed "Me" from the "Search.Value" and it works fine. So it's either in the "Me" or somewhere in your list of other textboxes. Try commenting them out half at a time to narrow it down.
Private Sub CommandButton1_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
mysearch = Search.Value
With ThisWorkbook.Sheets("Master Data")
Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
' Me.RsnDc = foundCell.Offset(0, 4).Value
' Me.BDM.Value = foundCell.Offset(0, 6).Value
' Me.MIns.Value = foundCell.Offset(0, 7).Value
' Me.EUs.Value = foundCell.Offset(0, 8).Value
' Me.In.Value = foundCell.Offset(0, 9).Value
' Me.Pr.Value = foundCell.Offset(0, 10).Value
' Me.Qu.Value = foundCell.Offset(0, 11).Value
' Me.ReCd.Value = foundCell.Offset(0, 12).Value
' Me.ReOrCd.Value = foundCell.Offset(0, 13).Value
' Me.Ttl.Value = foundCell.Offset(0, 5).Value
' Me.Va.Value = Me.Total.Value / 1.2
' Me.VT.Value = Me.Total.Value - Me.Value.Value
' Me.r.Value = foundCell.Offset(0, 17).Value
' Me.App.Value = foundCell.Offset(0, 18).Value
' Me.L1.Value = foundCell.Offset(0, 19).Value
' Me.L2.Value = foundCell.Offset(0, 20).Value
' Me.cy.Value = foundCell.Offset(0, 21).Value
' Me.pc.Value = foundCell.Offset(0, 22).Value
' Me.SN1.Value = Left(foundCell.Offset(0, 23).Value, 2)
' Me.SN2.Value = Mid(foundCell.Offset(0, 23).Value, 3, 2)
' Me.SN3.Value = Right(foundCell.Offset(0, 23).Value, 2)
' Me.ANCT.Value = foundCell.Offset(0, 24).Value
Beep
MsgBox "FOUND IT!"
Else
MsgBox "ID does not exist."
End If
End Sub
The issue appears to have been that in the search range column A was using a formula to dictate the search criteria. I have now built this into the userform and it seems to work a dream. Thanks for your time guys.
Related
Need help to add the code correctly for userform progress bar.
For Each cel In rList
Set fnd = ThisWorkbook.Worksheets("Database").Columns("A:A").Find(What:=cel.Value, LookAt:=xlWhole)
If Not fnd Is Nothing Then
fndFirst = fnd.Address
Do
fnd.Offset(0, 4).Value = cel.Offset(0, 4).Value
fnd.Offset(0, 5).Value = cel.Offset(0, 5).Value
fnd.Offset(0, 6).Value = cel.Offset(0, 6).Value
fnd.Offset(0, 7).Value = cel.Offset(0, 7).Value
fnd.Offset(0, 8).Value = cel.Offset(0, 8).Value
fnd.Offset(0, 9).Value = cel.Offset(0, 9).Value
fnd.Offset(0, 10).Value = cel.Offset(0, 10).Value
Set fnd = ThisWorkbook.Worksheets("Database").Columns("A:A").FindNext(After:=fnd)
Loop While fnd.Address <> fndFirst
End If
Next
Any help is highly appreciated. Thanks!
I am trying to copy several data from a table on a different sheet, to a new table on another sheet. My structure is like:
These are the steps that me and Mr. #QHarr have tried:
Checked the objects and values exist
Tried running the codes line by line
Activate sheets and re-arranging the codes
None worked so far:
Here is my current codes:
Private Sub cmdedit_Click()
If MsgBox("Transfer selected asset to " & Me.ComboBox1.Text & "?", vbYesNo, "CONFIRMATION") = vbYes Then
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim wsendRow As Range
Dim wsendRow1 As Range
Dim lo As ListObject
Dim lr As ListRow
Set ws = Sheets("FIELD OFFICE DATABASE")
Set ws1 = Sheets("Transferred Items")
Set lo = ws1.ListObjects("table3")
Set lr = lo.ListRows.Add
Set wsendRow = ws.Range("B" & Rows.Count).End(xlUp)
'Set wsendRow1 = ws1.Range("A" & Rows.Count).End(xlUp)
ws.Activate
Range("B2").Select
Do Until ActiveCell.Address = wsendRow.Address
If ActiveCell.Value = Me.cmbemn.Text Then
'ws1.Unprotect "321321"
'ws1.Activate
lr.Range(1, 1).Value = Me.cmbemn.Text 'error appears on this line. if I place a comment here, the error will just move on the next line.
lr.Range(1, 2).Value = Me.TextBox1.Text
lr.Range(1, 3).Value = Me.txttype.Text
lr.Range(1, 4).Value = Me.txtmodel.Text
lr.Range(1, 5).Value = ActiveCell.Offset(0, 4).Value
lr.Range(1, 6).Value = ActiveCell.Offset(0, 5).Value
lr.Range(1, 7).Value = Me.txtpurdate.Text
lr.Range(1, 8).Value = Me.txtprice.Text
lr.Range(1, 9).Value = Me.txtcon.Text
lr.Range(1, 10).Value = ActiveCell.Offset(0, 9).Value
lr.Range(1, 11).Value = ActiveCell.Offset(0, 11).Value
lr.Range(1, 12).Value = Me.ComboBox1.Text
lr.Range(1, 13).Value = ActiveCell.Offset(0, 13).Value
lr.Range(1, 14).Value = Date
lr.Range(1, 15).Value = ws.Range("A13").Value
lr.Range(1, 16).Value = Me.TextBox2.Text
Exit Do
Exit Sub
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End If
End Sub
Codes never worked. Also to note, this question is in reference to my other question, (which took a lot of comments from me and Mr. QHarr) until he suggested that I should ask another question instead.
I hope someone can help me figure this out.
Thank you so much in advance
I created a userform which has several textboxes and I use the foundcell to return the values of a line based on a reference number.
What I am wanting to do however is search a reference which is based in the searchrange below which is in and if .Range("AK") is blank to return. Else a msgbox to say that the criteria is not valid.
Please see me attempted code
Private Sub CommandButton1_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
mysearch = Ref.Value
With Sheets("X")
Set searchRange = Sheets("X").Range("AB2", .Range("AB" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell And foundCell.Offset(0, 9) Is Nothing Then
Me.C.Value = foundCell.Offset(0, -12).Value
Me.DD.Value = foundCell.Offset(0, -10).Value
Me.RD.Value = foundCell.Offset(0, -16).Value
Me.BN.Value = foundCell.Offset(0, -9).Value
Me.FN.Value = foundCell.Offset(0, -8).Value
Me.SHARP.Value = foundCell.Offset(0, -1).Value
Me.PGP.Value = foundCell.Offset(0, -7).Value
Me.ISS.Value = foundCell.Offset(0, -6).Value
Me.DE.Value = foundCell.Offset(0, -2).Value
Me.UN.Value = foundCell.Offset(0, -5).Value
Me.W.Value = foundCell.Offset(0, -4).Value
Me.IN.Value = foundCell.Offset(0, -3).Value
Me.CVAL.Value = foundCell.Offset(0, -20).Value
Me.ADD.Value = foundCell.Offset(0, -11).Value
Me.RESPONSE.Value = foundCell.Offset(0, 1).Value
Me.NRESPONSE.Value = foundCell.Offset(0, 2).Value
Me.MAREC.Value = foundCell.Offset(0, 4).Value
Me.MORET.Value = foundCell.Offset(0, 5).Value
Me.CNREC.Value = foundCell.Offset(0, 8).Value
Me.CNREF.Value = foundCell.Offset(0, 6).Value
Me.NVALUE.Value = foundCell.Offset(0, 7).Value
Me.CBY.Value = foundCell.Offset(0, 10).Value
Me.CDAT.Value = foundCell.Offset(0, 11).Value
Else
MsgBox "The Reference you have entered does not qualify and cannot be located. Please try another reference!"
End If
End Sub
You need to null-check foundCell on its own conditional, VBA's And logical operator doesn't short-circuit like VB.NET's AndAlso and C#'s && operator.
If Not foundCell Is Nothing Then
Also foundCell.Offset(0,9) could contain an error value, which will make any comparison operation throw a "Type Mismatch" run-time error. Use IsError to verify its error state before you assume it contains anything other than an error:
If Not IsError(foundCell.Offset(0, 9).Value) Then
Lastly, if your intent is to verify whether foundCell.Offset(0, 9) isn't empty, you can check in several ways, but Is Nothing isn't one of them:
IsBlank(foundCell.Offset(0, 9).Value) will return True if the cell contains nothing - no value, no formula.
foundCell.Offset(0, 9).Value <> vbNullString will return True if the cell's value is an empty string, or if its formula evaluates to an empty string.
foundCell.Offset(0, 9).Value <> "" will do the same as <> vbNullString.
Thus:
If Not foundCell Is Nothing Then
If Not IsBlank(foundCell.Offset(0, 9).Value) Then
Or:
If Not foundCell Is Nothing Then
If Not IsError(foundCell.Offset(0, 9).Value) Then
If foundCell.Offset(0, 9).Value <> vbNullString Then
If Not foundCell Is Nothing And foundCell.Offset(0, 9) <> """" Then
I have created a userform which searched a reference number and then populates the userform fields with entries on the line of that reference number in a "Mastersheet". The thing is that reference may actually be on 3 sheets with the same information and what I am wanting to do, is when I update the information pulled onto the userform to update all 3 sheets. Can you please assist?
Private Sub Update_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim ws4 As Worksheet
Set ws1 = Worksheets("MasterData")
Set ws2 = Worksheets("X")
Set ws3 = Worksheets("A")
Set ws4 = Worksheets("C")
mysearch = Me.Search.Value
With ThisWorkbook.Sheets("MasterData")
Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
foundCell.Offset(0, 11).Value = Me.RD.Value
foundCell.Offset(0, 17).Value = Me.DD.Value
foundCell.Offset(0, 12).Value = Me.PD.Value
foundCell.Offset(0, 13).Value = Me.NP.Value
foundCell.Offset(0, 14).Value = Me.Brd.Value
foundCell.Offset(0, 15).Value = Me.Com.Value
foundCell.Offset(0, 25).Value = Me.Dt.Value
foundCell.Offset(0, 20).Value = Me.PrGp.Value
foundCell.Offset(0, 21).Value = Me.Iss.Value
foundCell.Offset(0, 7).Value = Me.CVal.Value
foundCell.Offset(0, 22).Value = Me.Un.Value
foundCell.Offset(0, 23).Value = Me.Wt.Value
foundCell.Offset(0, 24).Value = Me.Invd.Value
foundCell.Offset(0, 26).Value = Me.Sh.Value
foundCell.Offset(0, 19).Value = Me.FS.Value
foundCell.Offset(0, 18).Value = Me.LN.Value
foundCell.Offset(0, 16).Value = Me.Add.Value
Else
MsgBox "ID does not exist."
End If
End Sub
Rather than dimming each sheet, what about just creating a collection for them, using a generic worksheet object, and iterating through the collection? see below.
Private Sub Update_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
Dim ws As Worksheet
Dim sheetCollection As Collection
Set sheetCollection = New Collection
With sheetCollection
.Add Worksheets("MasterData"), Worksheets("MasterData").Name
.Add Worksheets("X"), Worksheets("X").Name
.Add Worksheets("A"), Worksheets("A").Name
.Add Worksheets("C"), Worksheets("C").Name
End With
mysearch = Me.Search.Value
For Each ws In sheetCollection
With ws
Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
foundCell.Offset(0, 11).Value = Me.RD.Value
foundCell.Offset(0, 17).Value = Me.DD.Value
foundCell.Offset(0, 12).Value = Me.PD.Value
foundCell.Offset(0, 13).Value = Me.NP.Value
foundCell.Offset(0, 14).Value = Me.Brd.Value
foundCell.Offset(0, 15).Value = Me.Com.Value
foundCell.Offset(0, 25).Value = Me.Dt.Value
foundCell.Offset(0, 20).Value = Me.PrGp.Value
foundCell.Offset(0, 21).Value = Me.Iss.Value
foundCell.Offset(0, 7).Value = Me.CVal.Value
foundCell.Offset(0, 22).Value = Me.Un.Value
foundCell.Offset(0, 23).Value = Me.Wt.Value
foundCell.Offset(0, 24).Value = Me.Invd.Value
foundCell.Offset(0, 26).Value = Me.Sh.Value
foundCell.Offset(0, 19).Value = Me.FS.Value
foundCell.Offset(0, 18).Value = Me.Ln.Value
foundCell.Offset(0, 16).Value = Me.Add.Value
Else
MsgBox "ID(" & mysearch & ") does not exist in " & ws.name
End If
Next ws
End Sub
Hi to Any and all willing to assist.
I appear to be having issues with the left function in VBA. I am looking to search using a reference number and then the userform will pull through data that is stored within a table. In 1 section of the userform I have 4 text boxes looking to pull through different sections of 1 cell. The trouble is that I am getting "FO" for the answer on this for every reference which is actually looking at the fo within my code please see below.
Private Sub Find_Click()
Dim searchRange As Range
Dim foundCell As Range
Dim mysearch As String
mysearch = Me.Search.Value
With ThisWorkbook.Sheets("Master Data")
Set searchRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
End With
Set foundCell = searchRange.Find(what:=mysearch, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
Me.BDM.Value = foundCell.Offset(0, 6).Value
Me.Mrch.Value = foundCell.Offset(0, 7).Value
Me.EUs.Value = foundCell.Offset(0, 8).Value
Me.Pr.Value = foundCell.Offset(0, 10).Value
Me.Qty.Value = foundCell.Offset(0, 11).Value
Me.RsnCd.Value = foundCell.Offset(0, 12).Value
Me.ReOrCd.Value = foundCell.Offset(0, 13).Value
Me.Tot.Value = foundCell.Offset(0, 5).Value
Me.V.Value = Me.Total.Value / 1.2
Me.VT.Value = Me.Total.Value - Me.Value.Value
Me.Req.Value = foundCell.Offset(0, 17).Value
Me.Appl.Value = foundCell.Offset(0, 18).Value
Me.Line1.Value = foundCell.Offset(0, 19).Value
Me.Line2.Value = foundCell.Offset(0, 20).Value
Me.Ci.Value = foundCell.Offset(0, 21).Value
Me.Poe.Value = foundCell.Offset(0, 22).Value
Me.SC1.Value = Left(foundCell.Offset(0, 23).Value, 2)
'this is where in code I am receiving fo from the foundcell everytime
Else
MsgBox "ID does not exist."
End If
End Sub
I always thought the left in vba worked the same as excel which is left(a2, 2) for example
Unsure why but simply restarting excel resolved the issue and no issue with code