Code needs trimming

G

Glen M

New Member
Joined
Dec 30, 2019
Messages
16
Office Version
  1. 365
Platform
  1. Windows
I am a complete novice when it comes to VBA. I get the concepts but I am not very good at making this stuff simple. Here is all my code for my userform. As you can see I am not one for efficiency in my code. How can I clean this up so it is not so unruly? HAPPY NEW YEAR!

VBA Code: 
Private Sub cmdaddnew_Click()
Dim Wks As Worksheet
Dim addnew As Range

Set Wks = Sheet1
Set addnew = Wks.Range("a5000").End(xlUp).Offset(1, 0)

addnew.Offset(0, 0).Value = txtPO.Text
addnew.Offset(0, 1).Value = txtconf.Text
addnew.Offset(0, 2).Value = txtVendor.Text
addnew.Offset(0, 3).Value = txtname.Text
addnew.Offset(0, 4).Value = txtMisc.Text
addnew.Offset(0, 5).Value = txtPODate.Text
addnew.Offset(0, 7).Value = txtPOamt.Value
addnew.Offset(0, 8).Value = txtpaidamt.Value

txtPO.Text = ""
txtconf.Text = ""
txtVendor.Text = ""
txtname.Text = ""
txtPODate.Text = ""
txtPOamt.Text = ""
txtpaidamt.Text = ""
txtMisc.txt = ""

End Sub

Private Sub cmdexit_Click()
Dim iexit As VbMsgBoxResult
iexit = MsgBox("Confirm you want to exit", vbQuestion + vbYesNo, "PO Tracker")

If iexit = vbYes Then
Unload Me
End If

End Sub

Private Sub cmdprint_Click()
Application.Dialogs(xlDialogPrinterSetup).Show
ThisWorkbook.Sheets("Purchase Orders").PrintOut copies:=1

End Sub

Private Sub CmdRecon_Click()

   Dim i As Long
   
    For i = Cells(Rows.Count, 25).End(xlUp).Row To 1 Step -1
        If Cells(i, 25) = "y" Then
            Range("a" & i & ":Y" & i).Copy
        Sheet3.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            Cells(i, 25).EntireRow.Delete
        End If
    Next


End Sub

Private Sub cmdreset_Click()
Dim txt
    For Each txt In Frame2.Controls
        If TypeOf txt Is Msforms.TextBox Then
            txt.Text = ""
        End If
    Next txt
Worksheets("data").Range("a2:u1000").ClearContents

End Sub


Private Sub cmdsearchConf_Click()
Dim Rownum As Long
Dim Searchrow As Long

Rownum = 15
Searchrow = 2

Worksheets("Purchase Orders").Activate

If (txtconf.Text = "") Then
        MsgBox "You must enter the Confirmation#", vbOKOnly + vbCritical, "Missing Input"
        Exit Sub
    End If

Do Until Cells(Rownum, 1).Value = ""
 If InStr(1, Cells(Rownum, 2).Value, txtconf.Value, vbTextCompare) > 0 Then
   
    Worksheets("DATA").Cells(Searchrow, 1).Value = Cells(Rownum, 1).Value
    Worksheets("DATA").Cells(Searchrow, 2).Value = Cells(Rownum, 2).Value
    Worksheets("DATA").Cells(Searchrow, 3).Value = Cells(Rownum, 3).Value
    Worksheets("DATA").Cells(Searchrow, 4).Value = Cells(Rownum, 4).Value
    Worksheets("DATA").Cells(Searchrow, 5).Value = Cells(Rownum, 5).Value
    Worksheets("DATA").Cells(Searchrow, 6).Value = Cells(Rownum, 6).Value
    Worksheets("DATA").Cells(Searchrow, 7).Value = Cells(Rownum, 7).Value
    Worksheets("DATA").Cells(Searchrow, 8).Value = Cells(Rownum, 8).Value
    Worksheets("DATA").Cells(Searchrow, 9).Value = Cells(Rownum, 9).Value
    Worksheets("DATA").Cells(Searchrow, 10).Value = Cells(Rownum, 10).Value
    Worksheets("DATA").Cells(Searchrow, 11).Value = Cells(Rownum, 11).Value
    Worksheets("DATA").Cells(Searchrow, 12).Value = Cells(Rownum, 12).Value
    Worksheets("DATA").Cells(Searchrow, 13).Value = Cells(Rownum, 13).Value
    Worksheets("DATA").Cells(Searchrow, 14).Value = Cells(Rownum, 14).Value
    Worksheets("DATA").Cells(Searchrow, 15).Value = Cells(Rownum, 15).Value
    Worksheets("DATA").Cells(Searchrow, 16).Value = Cells(Rownum, 16).Value
    Worksheets("DATA").Cells(Searchrow, 17).Value = Cells(Rownum, 17).Value
    Worksheets("DATA").Cells(Searchrow, 18).Value = Cells(Rownum, 18).Value
    Worksheets("DATA").Cells(Searchrow, 19).Value = Cells(Rownum, 19).Value
    Worksheets("DATA").Cells(Searchrow, 20).Value = Cells(Rownum, 20).Value
    Worksheets("DATA").Cells(Searchrow, 21).Value = Cells(Rownum, 25).Value
     
    Searchrow = Searchrow + 1
        
    End If
    Rownum = Rownum + 1
Loop

If Searchrow = 2 Then
    MsgBox "The Confirmation# could not be found."
    Exit Sub
End If

lstdisplay.RowSource = "Vendor_Numbers"

End Sub

Private Sub cmdsearchID_Click()
Dim Rownum As Long
Dim Searchrow As Long

Rownum = 15
Searchrow = 2

Worksheets("Purchase Orders").Activate

If (txtVendor = "") Then
        MsgBox "You must enter the Vendor ID", vbOKOnly + vbCritical, "Missing Input"
        Exit Sub
    End If

Do Until Cells(Rownum, 1).Value = ""
 If InStr(1, Cells(Rownum, 3).Value, txtVendor.Value, vbTextCompare) > 0 Then
   
   Worksheets("DATA").Cells(Searchrow, 1).Value = Cells(Rownum, 1).Value
    Worksheets("DATA").Cells(Searchrow, 2).Value = Cells(Rownum, 2).Value
    Worksheets("DATA").Cells(Searchrow, 3).Value = Cells(Rownum, 3).Value
    Worksheets("DATA").Cells(Searchrow, 4).Value = Cells(Rownum, 4).Value
    Worksheets("DATA").Cells(Searchrow, 5).Value = Cells(Rownum, 5).Value
    Worksheets("DATA").Cells(Searchrow, 6).Value = Cells(Rownum, 6).Value
    Worksheets("DATA").Cells(Searchrow, 7).Value = Cells(Rownum, 7).Value
    Worksheets("DATA").Cells(Searchrow, 8).Value = Cells(Rownum, 8).Value
    Worksheets("DATA").Cells(Searchrow, 9).Value = Cells(Rownum, 9).Value
    Worksheets("DATA").Cells(Searchrow, 10).Value = Cells(Rownum, 10).Value
    Worksheets("DATA").Cells(Searchrow, 11).Value = Cells(Rownum, 11).Value
    Worksheets("DATA").Cells(Searchrow, 12).Value = Cells(Rownum, 12).Value
    Worksheets("DATA").Cells(Searchrow, 13).Value = Cells(Rownum, 13).Value
    Worksheets("DATA").Cells(Searchrow, 14).Value = Cells(Rownum, 14).Value
    Worksheets("DATA").Cells(Searchrow, 15).Value = Cells(Rownum, 15).Value
    Worksheets("DATA").Cells(Searchrow, 16).Value = Cells(Rownum, 16).Value
    Worksheets("DATA").Cells(Searchrow, 17).Value = Cells(Rownum, 17).Value
    Worksheets("DATA").Cells(Searchrow, 18).Value = Cells(Rownum, 18).Value
    Worksheets("DATA").Cells(Searchrow, 19).Value = Cells(Rownum, 19).Value
    Worksheets("DATA").Cells(Searchrow, 20).Value = Cells(Rownum, 20).Value
    Worksheets("DATA").Cells(Searchrow, 21).Value = Cells(Rownum, 25).Value
    Searchrow = Searchrow + 1
        
    End If
    Rownum = Rownum + 1
Loop

If Searchrow = 2 Then
    MsgBox "The Vendor ID could not be found."
    Exit Sub
End If

lstdisplay.RowSource = "Vendor_Numbers"

End Sub

Private Sub cmdsearchmisc_Click()
Dim Rownum As Long
Dim Searchrow As Long

Rownum = 15
Searchrow = 2

Worksheets("Purchase Orders").Activate

If (txtMisc = "") Then
        MsgBox "You must enter some text", vbOKOnly + vbCritical, "Missing Input"
        Exit Sub
    End If

Do Until Cells(Rownum, 1).Value = ""
 If InStr(1, Cells(Rownum, 5).Value, txtMisc.Value, vbTextCompare) > 0 Then
   
   Worksheets("DATA").Cells(Searchrow, 1).Value = Cells(Rownum, 1).Value
    Worksheets("DATA").Cells(Searchrow, 2).Value = Cells(Rownum, 2).Value
    Worksheets("DATA").Cells(Searchrow, 3).Value = Cells(Rownum, 3).Value
    Worksheets("DATA").Cells(Searchrow, 4).Value = Cells(Rownum, 4).Value
    Worksheets("DATA").Cells(Searchrow, 5).Value = Cells(Rownum, 5).Value
    Worksheets("DATA").Cells(Searchrow, 6).Value = Cells(Rownum, 6).Value
    Worksheets("DATA").Cells(Searchrow, 7).Value = Cells(Rownum, 7).Value
    Worksheets("DATA").Cells(Searchrow, 8).Value = Cells(Rownum, 8).Value
    Worksheets("DATA").Cells(Searchrow, 9).Value = Cells(Rownum, 9).Value
    Worksheets("DATA").Cells(Searchrow, 10).Value = Cells(Rownum, 10).Value
    Worksheets("DATA").Cells(Searchrow, 11).Value = Cells(Rownum, 11).Value
    Worksheets("DATA").Cells(Searchrow, 12).Value = Cells(Rownum, 12).Value
    Worksheets("DATA").Cells(Searchrow, 13).Value = Cells(Rownum, 13).Value
    Worksheets("DATA").Cells(Searchrow, 14).Value = Cells(Rownum, 14).Value
    Worksheets("DATA").Cells(Searchrow, 15).Value = Cells(Rownum, 15).Value
    Worksheets("DATA").Cells(Searchrow, 16).Value = Cells(Rownum, 16).Value
    Worksheets("DATA").Cells(Searchrow, 17).Value = Cells(Rownum, 17).Value
    Worksheets("DATA").Cells(Searchrow, 18).Value = Cells(Rownum, 18).Value
    Worksheets("DATA").Cells(Searchrow, 19).Value = Cells(Rownum, 19).Value
    Worksheets("DATA").Cells(Searchrow, 20).Value = Cells(Rownum, 20).Value
    Worksheets("DATA").Cells(Searchrow, 21).Value = Cells(Rownum, 25).Value
    Searchrow = Searchrow + 1
        
    End If
    Rownum = Rownum + 1
Loop

If Searchrow = 2 Then
    MsgBox "The text could not be found."
    Exit Sub
End If

lstdisplay.RowSource = "Vendor_Numbers"


End Sub

Private Sub cmdsearchNAME_Click()
Dim Rownum As Long
Dim Searchrow As Long

Rownum = 15
Searchrow = 2

Worksheets("Purchase Orders").Activate

If (txtname.Text = "") Then
        MsgBox "You must enter the Vendor Name", vbOKOnly + vbCritical, "Missing Input"
        Exit Sub
    End If

Do Until Cells(Rownum, 1).Value = ""
 If InStr(1, Cells(Rownum, 4).Value, txtname.Value, vbTextCompare) > 0 Then
   
    Worksheets("DATA").Cells(Searchrow, 1).Value = Cells(Rownum, 1).Value
    Worksheets("DATA").Cells(Searchrow, 2).Value = Cells(Rownum, 2).Value
    Worksheets("DATA").Cells(Searchrow, 3).Value = Cells(Rownum, 3).Value
    Worksheets("DATA").Cells(Searchrow, 4).Value = Cells(Rownum, 4).Value
    Worksheets("DATA").Cells(Searchrow, 5).Value = Cells(Rownum, 5).Value
    Worksheets("DATA").Cells(Searchrow, 6).Value = Cells(Rownum, 6).Value
    Worksheets("DATA").Cells(Searchrow, 7).Value = Cells(Rownum, 7).Value
    Worksheets("DATA").Cells(Searchrow, 8).Value = Cells(Rownum, 8).Value
    Worksheets("DATA").Cells(Searchrow, 9).Value = Cells(Rownum, 9).Value
    Worksheets("DATA").Cells(Searchrow, 10).Value = Cells(Rownum, 10).Value
    Worksheets("DATA").Cells(Searchrow, 11).Value = Cells(Rownum, 11).Value
    Worksheets("DATA").Cells(Searchrow, 12).Value = Cells(Rownum, 12).Value
    Worksheets("DATA").Cells(Searchrow, 13).Value = Cells(Rownum, 13).Value
    Worksheets("DATA").Cells(Searchrow, 14).Value = Cells(Rownum, 14).Value
    Worksheets("DATA").Cells(Searchrow, 15).Value = Cells(Rownum, 15).Value
    Worksheets("DATA").Cells(Searchrow, 16).Value = Cells(Rownum, 16).Value
    Worksheets("DATA").Cells(Searchrow, 17).Value = Cells(Rownum, 17).Value
    Worksheets("DATA").Cells(Searchrow, 18).Value = Cells(Rownum, 18).Value
    Worksheets("DATA").Cells(Searchrow, 19).Value = Cells(Rownum, 19).Value
    Worksheets("DATA").Cells(Searchrow, 20).Value = Cells(Rownum, 20).Value
    Worksheets("DATA").Cells(Searchrow, 21).Value = Cells(Rownum, 25).Value
    Searchrow = Searchrow + 1
        
    End If
    Rownum = Rownum + 1
Loop

If Searchrow = 2 Then
    MsgBox "The Vendor could not be found."
    Exit Sub
End If

lstdisplay.RowSource = "Vendor_Numbers"
End Sub


Private Sub CmdsearchPO_Click()
Dim Rownum As Long
Dim Searchrow As Long

Rownum = 15
Searchrow = 2

Worksheets("Purchase Orders").Activate

If (txtPO.Text = "") Then
        MsgBox "You must enter the PO#", vbOKOnly + vbCritical, "Missing Input"
        Exit Sub
    End If

Do Until Cells(Rownum, 1).Value = ""
 If InStr(1, Cells(Rownum, 1).Value, txtPO.Value, vbTextCompare) > 0 Then
   
    Worksheets("DATA").Cells(Searchrow, 1).Value = Cells(Rownum, 1).Value
    Worksheets("DATA").Cells(Searchrow, 2).Value = Cells(Rownum, 2).Value
    Worksheets("DATA").Cells(Searchrow, 3).Value = Cells(Rownum, 3).Value
    Worksheets("DATA").Cells(Searchrow, 4).Value = Cells(Rownum, 4).Value
    Worksheets("DATA").Cells(Searchrow, 5).Value = Cells(Rownum, 5).Value
    Worksheets("DATA").Cells(Searchrow, 6).Value = Cells(Rownum, 6).Value
    Worksheets("DATA").Cells(Searchrow, 7).Value = Cells(Rownum, 7).Value
    Worksheets("DATA").Cells(Searchrow, 8).Value = Cells(Rownum, 8).Value
    Worksheets("DATA").Cells(Searchrow, 9).Value = Cells(Rownum, 9).Value
    Worksheets("DATA").Cells(Searchrow, 10).Value = Cells(Rownum, 10).Value
    Worksheets("DATA").Cells(Searchrow, 11).Value = Cells(Rownum, 11).Value
    Worksheets("DATA").Cells(Searchrow, 12).Value = Cells(Rownum, 12).Value
    Worksheets("DATA").Cells(Searchrow, 13).Value = Cells(Rownum, 13).Value
    Worksheets("DATA").Cells(Searchrow, 14).Value = Cells(Rownum, 14).Value
    Worksheets("DATA").Cells(Searchrow, 15).Value = Cells(Rownum, 15).Value
    Worksheets("DATA").Cells(Searchrow, 16).Value = Cells(Rownum, 16).Value
    Worksheets("DATA").Cells(Searchrow, 17).Value = Cells(Rownum, 17).Value
    Worksheets("DATA").Cells(Searchrow, 18).Value = Cells(Rownum, 18).Value
    Worksheets("DATA").Cells(Searchrow, 19).Value = Cells(Rownum, 19).Value
    Worksheets("DATA").Cells(Searchrow, 20).Value = Cells(Rownum, 20).Value
    Worksheets("DATA").Cells(Searchrow, 21).Value = Cells(Rownum, 25).Value
    Searchrow = Searchrow + 1
        
    End If
    Rownum = Rownum + 1
Loop

If Searchrow = 2 Then
    MsgBox "The PO# could not be found."
    Exit Sub
End If

lstdisplay.RowSource = "Vendor_Numbers"

End Sub

Private Sub cmdupdate_Click()
Dim rng As Range
Dim i As Long
Dim lst As Range
Dim lastrow As Long

With Sheets("Purchase Orders")
Set rng = .Range("A:U")
Set rng = rng.Find(What:=Me.txtPO.Value, After:=.Range("A14"), LookAt:=xlWhole)

rng.Offset(0, 1).Value = Me.txtconf.Value
rng.Offset(0, 2).Value = Me.txtVendor.Value
rng.Offset(0, 3).Value = Me.txtname.Value
rng.Offset(0, 4).Value = Me.txtMisc.Value
rng.Offset(0, 5).Value = Me.txtPODate.Value
rng.Offset(0, 7).Value = Me.txtPOamt.Value
rng.Offset(0, 8).Value = Me.txtpaidamt.Value
rng.Offset(0, 9).Value = Me.TextBox1.Value
rng.Offset(0, 10).Value = Me.TextBox2.Value
rng.Offset(0, 11).Value = Me.TextBox3.Value
rng.Offset(0, 12).Value = Me.TextBox4.Value
rng.Offset(0, 13).Value = Me.TextBox5.Value
rng.Offset(0, 14).Value = Me.TextBox6.Value
rng.Offset(0, 15).Value = Me.TextBox7.Value
rng.Offset(0, 16).Value = Me.TextBox8.Value
rng.Offset(0, 17).Value = Me.TextBox9.Value
rng.Offset(0, 18).Value = Me.Txtship.Value
rng.Offset(0, 19).Value = Me.TextBox10.Value
rng.Offset(0, 24).Value = Me.txtRecon.Value


End With

End Sub


Private Sub lstdisplay_Click()

If lstdisplay <> "" Then

    Me.txtPO.Value = Me.lstdisplay.Column(0)
     Me.txtconf.Value = Me.lstdisplay.Column(1)
     Me.txtVendor.Value = Me.lstdisplay.Column(2)
      Me.txtname.Value = Me.lstdisplay.Column(3)
      Me.txtMisc.Value = Me.lstdisplay.Column(4)
      Me.txtPODate.Value = Me.lstdisplay.Column(5)
     Me.txtPOamt.Value = Me.lstdisplay.Column(7)
      Me.txtpaidamt.Value = Me.lstdisplay.Column(8)
      Me.TextBox1.Value = Me.lstdisplay.Column(9)
     Me.TextBox2.Value = Me.lstdisplay.Column(10)
      Me.TextBox3.Value = Me.lstdisplay.Column(11)
      Me.TextBox4.Value = Me.lstdisplay.Column(12)
     Me.TextBox5.Value = Me.lstdisplay.Column(13)
      Me.TextBox6.Value = Me.lstdisplay.Column(14)
      Me.TextBox7.Value = Me.lstdisplay.Column(15)
     Me.TextBox8.Value = Me.lstdisplay.Column(16)
      Me.TextBox9.Value = Me.lstdisplay.Column(17)
      Me.Txtship.Value = Me.lstdisplay.Column(18)
      Me.TextBox10.Value = Me.lstdisplay.Column(19)
      Me.txtRecon.Value = Me.lstdisplay.Column(20)
      Me.txtPODate.Text = Format(txtPODate.Value, "mm/dd/yy")
      
Else
End If

End Sub


Private Sub UserForm_Initialize()

Me.StartUpPosition = 0
  Me.Left = Application.Left + (0.5 * Application.Width) - (0.5 * Me.Width)
  Me.Top = Application.Top + (0.5 * Application.Height) - (0.5 * Me.Height)
lstdisplay.ColumnCount = 21

End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Sort by date Sort by votes
Hi Glen,

For starters, you can build in loops.

VBA Code: 
    Dim i As Long
    For i = 1 To 21
        Worksheets("DATA").Cells(Searchrow, i).Value = Cells(Rownum, i).Value
    Next i
 
Upvote 0
FryGirl said:
Hi Glen,

For starters, you can build in loops.

VBA Code: 
    Dim i As Long
    For i = 1 To 21
        Worksheets("DATA").Cells(Searchrow, i).Value = Cells(Rownum, i).Value
    Next i
Click to expand...
Ok, I can see that. But 21 = col 25 data. Does that matter?
 
Upvote 0
Glen M said:
Ok, I can see that. But 21 = col 25 data. Does that matter?
Click to expand...

Just insert a statement to change value of i to 25

some like

Rich (BB code): 
Worksheets("DATA").Cells(Searchrow, i).Value = Cells(Rownum, IIf(i = 21, 25, i)).Value

Dave
 
Upvote 0
dmt32 said:
Just insert a statement to change value of i to 25

some like

Rich (BB code): 
Worksheets("DATA").Cells(Searchrow, i).Value = Cells(Rownum, IIf(i = 21, 25, i)).Value

Dave
Click to expand...
Brilliant! This makes my code a little easier to look at. Thank you!

next?
 
Upvote 0
FryGirl said:
Personally, I don't see anything else obvious.
Click to expand...
No Way! Well then I don't feel so bad. I was looking at all those lines and going there must be a better way. I really need to get enrolled in a VBA/Excel class. Do you guys recommend any?
 
Upvote 0
Another suggestion where you have codes that largely repeat themselves is to create a common code & pass the required values to it as arguments



This is untested but you could work on something like following

VBA Code: 
Private Sub CmdsearchPO_Click()
    SearchRecord Search:=txtPO.Text.Text, SearchColumn:=1, Prompt:="You must enter PO#"
End Sub

Private Sub cmdsearchConf_Click()
    SearchRecord Search:=txtconf.Text, SearchColumn:=2, Prompt:="You must enter Confirmation#"
End Sub

Private Sub cmdsearchID_Click()
    SearchRecord Search:=txtVendor.Text, SearchColumn:=3, Prompt:="You must enter Vendor ID"
End Sub

Private Sub cmdsearchNAME_Click()
    SearchRecord Search:=txtname.Text.Text, SearchColumn:=4, Prompt:="You must enter Vendor Name"
End Sub

Private Sub cmdsearchmisc_Click()
    SearchRecord Search:=txtMisc.Text, SearchColumn:=5, Prompt:="You must enter Text"
End Sub

Sub SearchRecord(ByVal Search As String, ByVal  SearchColumn As Integer, Optional ByVal Prompt As Variant)
    Dim wsPurchaseOrders As Worksheet, wsData As Worksheet
    Dim FoundRecord As Range

    If IsMissing(Prompt) Then Prompt = "Search Text Entry Required"
  
    If Len(Search) = 0 Then MsgBox Prompt, 48, "Missing Input": Exit Sub
  
    With ThisWorkbook
        Set wsPurchaseOrders = .Worksheets("Purchase Orders")
        Set wsData = .Worksheets("DATA")
    End With
  
    Set FoundRecord = wsPurchaseOrders.Columns(SearchColumn).Find(Search, LookIn:=xlValues, lookat:=xlWhole)
  
    If Not FoundRecord Is Nothing Then
      
        With wsPurchaseOrders
            wsData.Cells(15, 1).Resize(, 20).Value = .Cells(FoundRecord.Row, 1).Resize(, 20).Value
            wsData.Cells(15, 21).Value = .Cells(FoundRecord.Row, 25).Value
        End With
      
    Else
        MsgBox Search & Chr(10) & "Record Not Found", 64, "Not Found"
    End If
  
    lstdisplay.RowSource = "Vendor_Numbers"
  
End Sub

As I said, its untested & is only intended to show how you can make use of one code for all the different search values / ranges you have

note: In common code, I have used the Range.Find method as it is much faster than looping but you can stick with the For next Loop @FryGirl suggested if it works for you.


Hope Helpful

Dave
 
Last edited:
Upvote 0
dmt32 said:
Another suggestion where you have codes that largely repeat themselves is to create a common code & pass the required values to it as arguments



This is untested but you could work on something like following

VBA Code: 
Private Sub CmdsearchPO_Click()
    SearchRecord Search:=txtPO.Text.Text, SearchColumn:=1, Prompt:="You must enter PO#"
End Sub

Private Sub cmdsearchConf_Click()
    SearchRecord Search:=txtconf.Text, SearchColumn:=2, Prompt:="You must enter Confirmation#"
End Sub

Private Sub cmdsearchID_Click()
    SearchRecord Search:=txtVendor.Text, SearchColumn:=3, Prompt:="You must enter Vendor ID"
End Sub

Private Sub cmdsearchNAME_Click()
    SearchRecord Search:=txtname.Text.Text, SearchColumn:=4, Prompt:="You must enter Vendor Name"
End Sub

Private Sub cmdsearchmisc_Click()
    SearchRecord Search:=txtMisc.Text, SearchColumn:=5, Prompt:="You must enter Text"
End Sub

Sub SearchRecord(ByVal Search As String, SearchColumn As Integer, Optional ByVal Prompt As String)
    Dim wsPurchaseOrders As Worksheet, wsData As Worksheet
    Dim FoundRecord As Range

    If IsMissing(Prompt) Then Prompt = "Search Text Entry Required"
   
    If Len(Search) = 0 Then MsgBox Prompt, 48, "Missing Input": Exit Sub
   
    With ThisWorkbook
        Set wsPurchaseOrders = .Worksheets("Purchase Orders")
        Set wsData = .Worksheets("DATA")
    End With
   
    Set FoundRecord = wsPurchaseOrders.Columns(SearchColumn).Find(Search, LookIn:=xlValues, lookat:=xlWhole)
   
    If Not FoundRecord Is Nothing Then
       
        With wsPurchaseOrders
            wsData.Cells(15, 1).Resize(, 20).Value = .Cells(FoundRecord.Row, 1).Resize(, 20).Value
            wsData.Cells(15, 21).Value = .Cells(FoundRecord.Row, 25).Value
        End With
       
    Else
        MsgBox Search & Chr(10) & "Record Not Found", 64, "Not Found"
    End If
   
    lstdisplay.RowSource = "Vendor_Numbers"
   
End Sub

As I said, its untested & is only intended to show how you can make use of one code for all the different search values / ranges you have

note: In common code, I have used the Range.Find method as it is much faster than looping but you can stick with the For next Loop @FryGirl suggested if it works for you.


Hope Helpful

Dave
Click to expand...
Very interesting concept. I will test it out and let you know what I find. Thanks!

I am all for making the program run faster because as the year wears on there will almost 2000 POs to search through.
 
Upvote 0
Glen M said:
Very interesting concept. I will test it out and let you know what I find. Thanks!

I am all for making the program run faster because as the year wears on there will almost 2000 POs to search through.
Click to expand...

I have used Range.Find Method on much larger data sets & never encountered any speed issues.

Good luck with project

Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
run time error 380 on user form
Replies
4
Views
334
NdNoviceHlp
NdNoviceHlp
P
  • Question
Code used for comparison between 2 list.
Replies
3
Views
306
Tupe77
T
M
  • Solved
VBA comparing cell values dosen't work consistantly
Replies
6
Views
110
michaelehoudek
M
S
  • Question
Output text vba should run10000 rows batch wise on every run till it ends.
Replies
0
Views
127
Sathish G
S
G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
286
Gajendran Yadhav
G

Forum statistics

Threads
1,214,920
Messages
6,122,279
Members
449,075
Latest member
staticfluids

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