Find Record by ID and transfer whole row data to multiple textboxes based on selection in list box VBA

M

Melimob

Active Member
Joined
Oct 16, 2011
Messages
395
Office Version
  1. 365
Hi, I hope I am going to be able to explain this and apologies in advance for my horrendous code but am new to all this..

ok so i have a listbox on the top part of the userform which shows search results from Valuations worksheet.
in the bottom part of the userform there are multipages representing 4 worksheets; Valuations, Listings, Sales, Exchanges.
All records start on Valuations worksheet and could be on the Listings, Sales, Exchanges all tied together with a Unique ID.
Currently user selects a row in the listbox and the below code should:

1) populate all textboxes across all 4 pages with the 'constant data' shown as 'x' *This part works fine*

what doesn't currently work is the 'y, z, a' or else part..
2) it should look for the UID in the other 3 worksheets and if found, return the row/column data to the relevant multipage textbox as mapped out below.
3) if it doesn't find the UID on the other worksheets, it should just leave those textboxes blank ready for input

I did get point 2 to work before I added the else but with the 'else' 2 nor 3 seems to work?

Many thanks in advance > this has taken me hourssssssssssssss!
any advice appreciated! :)



Code: 
Private Sub lstSearch_Click()


'dim the variables
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim a As Integer


Dim ws As Worksheet
Dim wsl As Worksheet
Dim wss As Worksheet
Dim wse As Worksheet




Dim wsLR As Long


'find the selected list item
i = Me.lstSearch.ListIndex
Me.lstSearch.Selected(i) = True


'send UID to datasheet


Sheets("Valuations").Range("v6").Value = Me.lstSearch.Column(0, i)


Set ws = ThisWorkbook.Sheets("Valuations")
Set wsl = ThisWorkbook.Sheets("Listings")
Set wss = ThisWorkbook.Sheets("Sales")
Set wse = ThisWorkbook.Sheets("Exchanges")




 wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Row


For x = 13 To wsLR
    
    If ws.Cells(x, 1) = Sheets("Valuations").Range("v6").Value Then
        
        'constants from Valuations sheets sent to all 4 multipages
        
        Me.tbUIDVal = ws.Cells(x, "A").Text
        Me.tbUIDList = ws.Cells(x, "A").Text
        Me.tbUIDSales = ws.Cells(x, "A").Text
        Me.tbUIDExc = ws.Cells(x, "A").Text
        
        Me.cbxOfficeVal = ws.Cells(x, "B")
        Me.cbxOfficeList = ws.Cells(x, "B")
        Me.cbxOffSales = ws.Cells(x, "B")
        Me.cbxOffDtlExc = ws.Cells(x, "B")
        
        Me.tbHouseVal = ws.Cells(x, "E")
        Me.tbHouseList = ws.Cells(x, "E")
        Me.tbHouseSales = ws.Cells(x, "E")
        Me.tbHouseExc = ws.Cells(x, "E")
        
        Me.tbStreetVal = ws.Cells(x, "F")
        Me.tbStreetList = ws.Cells(x, "F")
        Me.tbStreetSales = ws.Cells(x, "F")
        Me.tbStreetExc = ws.Cells(x, "F")
        
        Me.tbCityVal = ws.Cells(x, "G")
        Me.tbCityList = ws.Cells(x, "G")
        Me.tbCitySales = ws.Cells(x, "G")
        Me.tbCityExc = ws.Cells(x, "G")
        
        Me.tbPostCodeVal = ws.Cells(x, "H")
        Me.tbPostCodeList = ws.Cells(x, "H")
        Me.tbPostCodeSales = ws.Cells(x, "H")
        Me.tbPostCodeExc = ws.Cells(x, "H")
        
        Me.tbValueAmountVal = ws.Cells(x, "J")
        Me.tbValAmntList = ws.Cells(x, "J")
        Me.tbValueAmntSales = ws.Cells(x, "J")
        Me.tbValAmntExc = ws.Cells(x, "J")
        
        Me.tbVendorVal = ws.Cells(x, "I")
        Me.tbVendorList = ws.Cells(x, "I")
        Me.tbVendorSales = ws.Cells(x, "I")
        Me.tbVendorExc = ws.Cells(x, "I")
        
        
        
    'cells on valuations worksheet that should only be sent to Valuations multipage
        Me.tbDateVal = ws.Cells(x, "C")
        Me.cbxValuer = ws.Cells(x, "D")
        Me.chbValLetter = ws.Cells(x, "K")
        Me.cbxEnqSourceVal = ws.Cells(x, "L")
        Me.cbxDataSourceVal = ws.Cells(x, "M")
        Me.tbNotesVal = ws.Cells(x, "N")
        


     End If
Next x
   
   
   For y = 13 To wsLR
     If wsl.Cells(y, 1) = Sheets("Valuations").Range("v6").Value Then
    
        'get stats from Listings worksheet for addtional fields to add to listings page if record found
        
        Me.tbDateList = wsl.Cells(y, "C")
        Me.cbxLister = wsl.Cells(y, "D")
        Me.chbBoardList = wsl.Cells(y, "M")
        Me.chbPM2 = wsl.Cells(y, "N")
        Me.tbPriceList = wsl.Cells(y, "J")
        Me.tbPriceSales = ws.Cells(y, "J")
        Me.tbFeeList = wsl.Cells(y, "K")
        Me.cbxStatusList = wsl.Cells(y, "O")
        Me.tbNotesList = wsl.Cells(y, "L")
        
        'Comes from Listing worksheet to Exchange Multipage
         Me.tbPriceExc = wsl.Cells(y, "J")
         Me.cbxUpdateListStatusExc = wsl.Cells(y, "O")
        
    
    Else
        Me.tbDateList = ""
        Me.cbxLister = ""
        Me.chbBoardList = ""
        Me.chbPM2 = ""
        Me.tbPriceList = ""
        Me.tbPriceSales = ""
        Me.tbFeeList = ""
        Me.cbxStatusList = ""
        Me.tbNotesList = ""
        
        Me.tbPriceExc = ""
        Me.cbxUpdateListStatusExc = ""
        
        
 End If
 Next y
 
    For z = 13 To wsLR
     If wss.Cells(z, 1) = Sheets("Valuations").Range("v6").Value Then
    
        'get stats from Sales worksheet for addtional fields to add to Sales page if record found
        
        Me.tbDateSales = wss.Cells(z, "C")
        Me.cbxNegSales = wss.Cells(z, "D")
        Me.chbSale = wss.Cells(z, "K")
        Me.chbAbort = wss.Cells(z, "K")
        Me.tbPurchaserSales = wss.Cells(z, "I")
        Me.tbFeeSales = wss.Cells(z, "J")
        Me.tbNotesSales = wss.Cells(z, "L")
        
        'comes from Sales worksheet to Exchange multipage
        Me.tbPurchaserExc = wss.Cells(z, "I")
        
    Else
        Me.tbDateSales = ""
        Me.cbxNegSales = ""
        Me.chbSale = ""
        Me.chbAbort = ""
        Me.tbPurchaserSales = ""
        Me.tbFeeSales = ""
        Me.tbNotesSales = ""
        
        Me.tbPurchaserExc = ""
 
   End If
 Next z
 
 For a = 13 To wsLR
 
 If wse.Cells(a, 1) = Sheets("Valuations").Range("v6").Value Then
        Me.tbDateExc = wse.Cells(a, "C")
        Me.tbDateCompExc = wse.Cells(a, "K")
        Me.tbDatePaidExc = wse.Cells(a, "L")
        Me.chbOffSplitExc = wse.Cells(a, "N")
        Me.chbIntheBookExc = wse.Cells(a, "M")
        Me.tbListByExc = wse.Cells(a, "H")
        Me.tbSoldByExc = wse.Cells(a, "I")
        Me.tbFeeExc = wse.Cells(a, "J")
        
 Else
        Me.tbDateExc = ""
        Me.tbDateCompExc = ""
        Me.tbDatePaidExc = ""
        Me.chbOffSplitExc = ""
        Me.chbIntheBookExc = ""
        Me.tbListByExc = ""
        Me.tbSoldByExc = ""
        Me.tbFeeExc = ""
       
 End If
 Next a
 
 Exit Sub
    
End Sub
 
Last edited:

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
Sort by date Sort by votes
Hi,
If you are searching many records on sheets then consider using Find Function - much quicker than stepping through each record with loops.

To save repeating code in your project, I have created a common Find Function for you & example how to use it.

Function:
Code: 
Function FindCell(ByVal sh As Object, ByVal What As String, Optional ByVal WhichColumn As Variant = 1) As Range
    Set FindCell = sh.Columns(WhichColumn).Find(What:=What, After:=sh.Cells(1, 1), LookIn:=xlValues, _
                                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                MatchCase:=False, SearchFormat:=False)
End Function


Use Example:

Code: 
Private Sub CommandButton1_Click()


    Dim FoundCell As Range
    Dim wsListings As Worksheet
    Dim DataRow As Long
    Dim Search As String
    


    Set wsListings = Sheets("Listings")
    Search = Me.tbUIDList.Text


    Set FoundCell = FindCell(sh:=wsListings, What:=Search, WhichColumn:=1)


    If Not FoundCell Is Nothing Then
        
        DataRow = FoundCell.Row


        'Update code here
    Else
        
        With wsListings
            DataRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        End With
        
        'new record code here
        
    End If
    
End Sub

Hope Helpful

Dave
 
Upvote 0
dmt32 said:
Hi,
If you are searching many records on sheets then consider using Find Function - much quicker than stepping through each record with loops.

To save repeating code in your project, I have created a common Find Function for you & example how to use it.

Function:
Code: 
Function FindCell(ByVal sh As Object, ByVal What As String, Optional ByVal WhichColumn As Variant = 1) As Range
    Set FindCell = sh.Columns(WhichColumn).Find(What:=What, After:=sh.Cells(1, 1), LookIn:=xlValues, _
                                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                MatchCase:=False, SearchFormat:=False)
End Function


Use Example:

Code: 
Private Sub CommandButton1_Click()    Dim FoundCell As Range    Dim wsListings As Worksheet    Dim DataRow As Long    Dim Search As String        Set wsListings = Sheets("Listings")    Search = Me.tbUIDList.Text    Set FoundCell = FindCell(sh:=wsListings, What:=Search, WhichColumn:=1)    If Not FoundCell Is Nothing Then                DataRow = FoundCell.Row        'Update code here    Else                With wsListings            DataRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1        End With                'new record code here            End If    End Sub

Hope Helpful

Dave
Click to expand...


Dave thank you AGAIN so much, this is much improved on mine however I am getting Object required and highlighting foundcell? I've just entered one sheet so far as a test:

Code: 
Private Sub lstSearch_Click()
Dim wsListings As Worksheet
    Dim DataRow As Long
    Dim Search As String
    Dim foundcell As String
    




    Set wsListings = Sheets("Listings")
    Search = Me.tbUIDList.Text




    Set foundcell = FindCell(sh:=wsListings, What:=Search, WhichColumn:=1)




    If Not foundcell Is Nothing Then
         
        DataRow = foundcell.Row
        
        Me.tbDateList = wsListings.Range("C" & DataRow).Value
        Me.cbxLister = wsListings.Range("D" & DataRow).Value
        Me.chbBoardList = wsListings.Range("M" & DataRow).Value
        Me.chbPM2 = wsListings.Range("N" & DataRow).Value
        Me.tbPriceList = wsListings.Range("J" & DataRow).Value
        Me.tbFeeList = wsListings.Range("K" & DataRow).Value
        Me.cbxStatusList = wsListings.Range("O" & DataRow).Value
        Me.tbNotesList = wsListings.Range("L" & DataRow).Value
        
        'Comes from Listing worksheet to Exchange Multipage
         Me.tbPriceExc = wsListings.Range("J" & DataRow).Value
         Me.cbxUpdateListStatusExc = wsListings.Range("O" & DataRow).Value
        
    Else
        
        With wsListings
            DataRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        End With
        
        Me.tbDateList = ""
        Me.cbxLister = ""
        Me.chbBoardList = ""
        Me.chbPM2 = ""
        Me.tbPriceList = ""
        Me.tbPriceSales = ""
        Me.tbFeeList = ""
        Me.cbxStatusList = ""
        Me.tbNotesList = ""
        
        Me.tbPriceExc = ""
        Me.cbxUpdateListStatusExc = ""
        
    End If
    
End Sub

Hope I've done it right? And I've saved the function in a module too exactly as you've put. I've also declared the 'foundcell' as String as got a 'variable not found' error?

If I can get one to work then I'll know how to proceed with the other worksheets/pages.

Sorry for my ignorance, I know I have still probably added my code incorrectly but am not sure how to write it?

Many thanks again, it truly is appreciated.
 
Upvote 0
Oh and I've just realised, in my previous code I was saying the item/value I was looking for is the selected row of listbox column 0 which is also sent to Sheets("Valuations").Range("v6").Value

tbUIDList should equal this value same as all the other textbox UID's so I should use either the list column or the cell v6 on Valuation sheet as my search right?
 
Upvote 0
Hi,
FoundCell is declared as Range in my example -Also, did you copy the Function to your project?

Dave
 
Upvote 0
dmt32 said:
Hi,
FoundCell is declared as Range in my example -Also, did you copy the Function to your project?

Dave
Click to expand...

Sorry Dave, I missed copying the foundcell as range so have updated that now.

Did I add my pieces of code correctly? I've run it and not getting error but nothing is happening? I guess this is because (if I am reading it correctly) the item it's searching in is: Me.tbUIDList.Text but this will be empty as I need to send whatever is selected (clicked) in listbox, UID is sent to this box and then the code runs, alternatively, it will read from column 0 in the list box based on what has been selected (clicked).

Yes, I copied the function data into a module.

thank you in advance..
 
Upvote 0
Melimob said:
Sorry Dave, I missed copying the foundcell as range so have updated that now.

Did I add my pieces of code correctly? I've run it and not getting error but nothing is happening? I guess this is because (if I am reading it correctly) the item it's searching in is: Me.tbUIDList.Text but this will be empty as I need to send whatever is selected (clicked) in listbox, UID is sent to this box and then the code runs, alternatively, it will read from column 0 in the list box based on what has been selected (clicked).

Yes, I copied the function data into a module.

thank you in advance..
Click to expand...

Hi Dave

Based on the above concept I passed the UID to tbUIDList box in the hope it would help but even though the value is now appearing in this box it still doesn't do anything and I'm sure it's to do with the way I've written my part in the code ???? Also, the format of the UID is custom number so is RM + number e.g. RM084. I had this working previously by changing the property to .text instead of .value however now it just shows the number value does this matter/affect code? if not, I'm not worried that it just shows the number.

Code: 
Dim wsListings As Worksheet
    Dim DataRow As Long
    Dim Search As String
    Dim foundcell As Range
    Dim i As Integer
    
    'find the selected list item
i = Me.lstSearch.ListIndex
Me.lstSearch.Selected(i) = True


'send UID to textbox


Me.tbUIDList.Text = Me.lstSearch.Column(0, i)

Many thanks
 
Upvote 0
You need to pass the UID from your Listbox to the Search variable.

Something like following:

Code: 
i = Me.lstSearch.ListIndex


If i < 0 Then Exit Sub
'search UID
Search = Me.lstSearch.Column(0, i)

'rest of code.

Dave
 
Upvote 0
dmt32 said:
You need to pass the UID from your Listbox to the Search variable.

Something like following:

Code: 
i = Me.lstSearch.ListIndex


If i < 0 Then Exit Sub
'search UID
Search = Me.lstSearch.Column(0, i)

'rest of code.

Dave
Click to expand...

Hi Dave

So sorry about all the questions but still doesn't pass any other textboxes when I know the row exists on the Listings sheet. This is total what I have:

Functions:
Code: 
Function FindCell(ByVal sh As Object, ByVal What As String, Optional ByVal WhichColumn As Variant = 1) As Range
    Set FindCell = sh.Columns(WhichColumn).find(What:=What, After:=sh.Cells(1, 1), LookIn:=xlValues, _
                                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                MatchCase:=False, SearchFormat:=False)
End Function

code in list box:
Code: 
Private Sub lstSearch_Click()


Dim wsListings As Worksheet
    Dim DataRow As Long
    Dim Search As String
    Dim foundcell As Range
    Dim i As Integer
    
 i = Me.lstSearch.ListIndex


If i < 0 Then Exit Sub
'search UID


   
 Me.lstSearch.Selected(i) = True


'send UID to worksheet


Me.tbUIDList.Text = Me.lstSearch.Column(0, i)




    Set wsListings = Sheets("Listings")
    'Search = Me.tbUIDList.Text
    Search = Me.lstSearch.Column(0, i)


    Set foundcell = FindCell(sh:=wsListings, What:=Search, WhichColumn:=1)




    If Not foundcell Is Nothing Then
         
        DataRow = foundcell.Row
        
        Me.tbDateList = wsListings.Range("C" & DataRow).Value
        Me.cbxLister = wsListings.Range("D" & DataRow).Value
        Me.chbBoardList = wsListings.Range("M" & DataRow).Value
        Me.chbPM2 = wsListings.Range("N" & DataRow).Value
        Me.tbPriceList = wsListings.Range("J" & DataRow).Value
        Me.tbFeeList = wsListings.Range("K" & DataRow).Value
        Me.cbxStatusList = wsListings.Range("O" & DataRow).Value
        Me.tbNotesList = wsListings.Range("L" & DataRow).Value
        
        'Comes from Listing worksheet to Exchange Multipage
         Me.tbPriceExc = wsListings.Range("J" & DataRow).Value
         Me.cbxUpdateListStatusExc = wsListings.Range("O" & DataRow).Value
        
    Else
        
        With wsListings
            DataRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        End With
        
        Me.tbDateList = ""
        Me.cbxLister = ""
        Me.chbBoardList = ""
        Me.chbPM2 = ""
        Me.tbPriceList = ""
        Me.tbPriceSales = ""
        Me.tbFeeList = ""
        Me.cbxStatusList = ""
        Me.tbNotesList = ""
        
        Me.tbPriceExc = ""
        Me.cbxUpdateListStatusExc = ""
        
    End If
    
End Sub

Many thanks
 
Upvote 0
Melimob said:
Hi Dave

So sorry about all the questions but still doesn't pass any other textboxes when I know the row exists on the Listings sheet. This is total what I have:

Functions:
Code: 
Function FindCell(ByVal sh As Object, ByVal What As String, Optional ByVal WhichColumn As Variant = 1) As Range
    Set FindCell = sh.Columns(WhichColumn).find(What:=What, After:=sh.Cells(1, 1), LookIn:=xlValues, _
                                                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                                MatchCase:=False, SearchFormat:=False)
End Function

code in list box:
Code: 
Private Sub lstSearch_Click()


Dim wsListings As Worksheet
    Dim DataRow As Long
    Dim Search As String
    Dim foundcell As Range
    Dim i As Integer
    
 i = Me.lstSearch.ListIndex


If i < 0 Then Exit Sub
'search UID


   
 Me.lstSearch.Selected(i) = True


'send UID to worksheet


Me.tbUIDList.Text = Me.lstSearch.Column(0, i)




    Set wsListings = Sheets("Listings")
    'Search = Me.tbUIDList.Text
    Search = Me.lstSearch.Column(0, i)


    Set foundcell = FindCell(sh:=wsListings, What:=Search, WhichColumn:=1)




    If Not foundcell Is Nothing Then
         
        DataRow = foundcell.Row
        
        Me.tbDateList = wsListings.Range("C" & DataRow).Value
        Me.cbxLister = wsListings.Range("D" & DataRow).Value
        Me.chbBoardList = wsListings.Range("M" & DataRow).Value
        Me.chbPM2 = wsListings.Range("N" & DataRow).Value
        Me.tbPriceList = wsListings.Range("J" & DataRow).Value
        Me.tbFeeList = wsListings.Range("K" & DataRow).Value
        Me.cbxStatusList = wsListings.Range("O" & DataRow).Value
        Me.tbNotesList = wsListings.Range("L" & DataRow).Value
        
        'Comes from Listing worksheet to Exchange Multipage
         Me.tbPriceExc = wsListings.Range("J" & DataRow).Value
         Me.cbxUpdateListStatusExc = wsListings.Range("O" & DataRow).Value
        
    Else
        
        With wsListings
            DataRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        End With
        
        Me.tbDateList = ""
        Me.cbxLister = ""
        Me.chbBoardList = ""
        Me.chbPM2 = ""
        Me.tbPriceList = ""
        Me.tbPriceSales = ""
        Me.tbFeeList = ""
        Me.cbxStatusList = ""
        Me.tbNotesList = ""
        
        Me.tbPriceExc = ""
        Me.cbxUpdateListStatusExc = ""
        
    End If
    
End Sub

Many thanks
Click to expand...

Hi Dave

I just wanted to clarify what it should be doing in case I have confused things..

user selects an item in listbox
based on selected item column 0 in listbox which is the UID, all multipages textboxes should populate with relevant data.
Valuations worksheet > feeds 'constant' texboxes across all multipages
If UID found in Listings > additional textboxes should be read from Listings worksheet, if not, 'additional' textboxes are blank so that user can add as new record (add new record is part of another commndbutton).
If UID found in Sales page > additional textboxes should be read from Sales worksheet...and so on..

So simply, find if record is on any of the worksheets and populate the textboxes or leave blank if not found.

Many thanks again...
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Clear Row Data based on Date Range
Replies
3
Views
347
DanteAmor
DanteAmor
M
  • Question
VBA Find value and send corresponding row values to text boxes but from multiple sheets
Replies
0
Views
735
Melimob
M

Forum statistics

Threads
1,215,103
Messages
6,123,107
Members
449,096
Latest member
provoking

Share this page

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