Populate Form Based On Non Unique Number and Display Next 3 Instances of that number

realitycheck

New Member
Joined
Aug 29, 2014
Messages
9
Hello all! It's been a few years since I've needed your assistance, but alas, the draw of programming VBA sucked me in once again.

I've developed a program for data entry for a record store that sells online years ago and the code still functions fine although some modules need improvement.

Right now I have functioning code which finds a non-unique number from column F (The Discogs Number) and returns the required values from that row to the form.


THIS FORM: WHEN YOU CLICK THE RED CIRCLED BUTTON...

LhvTLH4.jpg


The code finds the most recent occurrence of that discogs number and populates the form like this with 1 Price Only

IqqB8ZI.jpg


You'll notice it brings back that artist but doesn't bring back more than the first found record. The proposed new code display area is price 2, price 3 above that.

Since often the same record is sold at different prices based on condition of the vinyl and condition of the sleeve. To give the user more of an idea of how it it should be priced based on condition I would like the existing code to continue looking and then...

1. Create a text box on the form with the next known occurrence price and it's media condition and sleeve condition and 2. if there are more than 2 do 3. You'll notice the area on the form labeled price 2, and so on that I would like to appear only when there is more than one occurrence of the discogs number and then delete those text boxes after the record is processed.

Here is the code that works perfectly for the one record only...

Code:
Private Sub DiscogsR_Click()


'prompts user
Dim MyResponse As String
MyResponse7 = InputBox("Paste Discogs ID")
If MyResponse7 = "" Then
    MsgBox "No Number Entered.  Aborting.", vbCritical
    Exit Sub
End If

'takes entry and searches for it and returns that row to the form

    Dim strFind, FirstAddress As String   'what to find
    Dim rSearch As Range, intRange As Range  'range to search
    
Dim ws1
Dim ws2

Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim RNG4 As Range
Dim RNG5 As Range
Dim cell As Range

WB1 = "Wata.xlsm"


ws2 = "DATA"
ws3 = "Miss Q Data"

Dim ws5 As Worksheet
Dim Found As Range

Dim AddressStr As String
Set ws5 = ActiveSheet

    Set rSearch = Workbooks(WB1).Sheets(ws2).Range("F1:F" & Workbooks(WB1).Sheets(ws2).Range("F" & Workbooks(WB1).Sheets(ws2).Rows.Count).End(xlUp).Row)
    strFind = MyResponse7   'what to look for
    Dim F As Integer, strRange As Range
        With rSearch
        Set C = .Find(strFind, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious)
        
        
 'if item not found then check Miss Q sheet
 
 If C Is Nothing Then
              MsgBox "The Discogs item number doesn't exist on DATA sheet."
              cbodiscogs = MyResponse7
Me.cboartist.SetFocus
            
              
End If

            If Not C Is Nothing Then    'found it
                
                
            
            cbodiscogs = MyResponse7
                
Me.cboartist.Value = C.Offset(0, -5).Value
Me.cbotitle.Value = C.Offset(0, -4).Value
Me.cborecdescshort.Value = C.Offset(0, -3).Value
Me.cboreleaseno.Value = C.Offset(0, -2).Value
Me.txtstockno.Value = 1

Me.txtprice.Value = C.Offset(0, 1).Value
Me.txtprice.ForeColor = vbRed

Me.cborecordcond = C.Offset(0, 2).Value
Me.cborecordcond.ForeColor = vbRed

Me.cbocovercond = C.Offset(0, 3).Value
Me.cbocovercond.ForeColor = vbRed

Me.cbocoverinfo = C.Offset(0, 4).Value
Me.cbocoverinfo.ForeColor = vbRed

Me.cbocondcomments = C.Offset(0, 5).Value
Me.cbocondcomments.ForeColor = vbRed

Me.cbogenre.Value = C.Offset(0, 6).Value
Me.txtyear.Value = C.Offset(0, 7).Value
Me.cbolabel.Value = C.Offset(0, 8).Value
Me.cbocountry.Value = C.Offset(0, 9).Value
Me.txtdescription.Value = C.Offset(0, 11).Value
                
              Me.txtprice.SetFocus
              
    End If
    
    End With

              


End Sub

This code is great because it works well with one. Can I embed this in another loop that keeps looking until it finds a max of 3 more items? And then how can I get it to "draw" the text box with the price and media and sleve condtion that gets wiped out when the record is entered?


WITH THIS Example sheet:

Gregory IsaacsNight NurseLP120752677.99VGVG
Jay JayDo You Really Love Me12133445123.99GG
Jay JayDo You Really Love Me121334451259.99MEX
Jay JayDo You Really Love Me12133445122.99MM
Jay JayDo You Really Love Me1211.99MM

<tbody>
</tbody>



...The proposed populated form should look like this...

IXpW4Rb.jpg




Can I do this with a do while loop? or do I need to do this a different way? How can I keep the existing code and enhance it to keep going as it finds more instances?

If I need to make things more clear please ask, hopefully my goal is spelled out well.

Thanks a million!

Joe
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Ok so it's clear I can't use the exact code without creating more storage holders...

But what about the embedding of the existing code within a do while loop, is that possible or should I scratch what I have just to get the next 3 records?

Anyone??
 
Upvote 0
I found a good headstart on this, C-Pearson's FIND ALL function would work nicely but I still don't know which chunk of code on H will work best.


His example:

Code:
Dim FoundCell As Range
 Dim LastCell As Range
 Dim FirstAddr As String 

With Range("A1:A10")     
Set LastCell = .Cells(.Cells.Count) End With Set FoundCell = Range("A1:A10").Find(what:="a", after:=LastCell)  

If Not FoundCell Is Nothing Then     
FirstAddr = FoundCell.Address End If  Do Until FoundCell Is Nothing     

Debug.Print FoundCell.Address     

Set FoundCell = Range("A1:A10").FindNext(after:=FoundCell)     

If FoundCell.Address = FirstAddr Then         Exit Do     End If Loop

Anyone?
 
Upvote 0

Forum statistics

Threads
1,214,861
Messages
6,121,969
Members
449,059
Latest member
oculus

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