I need 2 macro codes. Can anyone help me?

Blank

Blank

New Member
Joined
Jun 19, 2009
Messages
14
Hello mrexcel users,
Can anyone help me? :)

I need 2 macro codes wich can do the following (one is for a search button, the other one for a modify button):

If I input a value in the left box of the search frame, I want it to look for the value in the range B8:B1008 and if I input a value in the right box I want it to look for the value in D8:D1008 and all of this I want done with the search button I mentioned above.

If the value isn't found in the specified range I want it to show "Not Found!" in the label underneath the search button.

If the value is found I want it to write the values in the left frame as follows:
- in the first box, the value found in column B;
- in the second box, the value found in column C;
- in the third box, the value found in column D;
- in the forth box, the value found in column E;
- in the fifth box, the value found in colmn F;
- in the sixth box, the value found in column G.

If I press the modify button, I want it to be able to write all the values on the specific row. Also if the value is found I want the row to be selected (not highlighted with a color).

The search frame is named "Frame1" and the modify frame is named "Frame2";
The box in the left of the search frame is named "txtPN2" and the one on the right is named "txtNM2";
The search button is named "cmdCauta" and the label underneath the button is "label10";
The first box in the modify frame is named "txtPN1", the second "txtNB1"; the third "txtNM1"; the forth "txtL1"; the fifth "txtSM1" and the sixth "txtObs1".
The modify button is named "cmdModifica".
The sheet in wich this form should work is "ATR-42".

I have attached a photo of the form.

0B7fUlU11BuUCNjE4ODg4NTktNzg1ZS00ODRjLTkxODctOGY2NGI4OTVmNDVj
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
Hi ,

I am not able to see your picture.
Could you please tell me , is both the search criteria should be met? or only one criteria is sufficient? if second case is true then what if both are filled. which should get prefrence?
 
Upvote 0
Code: 
Public lngRowB As Long
Private Sub cmdCauta_Click()
Dim blnFindB As Boolean
Dim blnFindD As Boolean
'Dim lngRowB As Long
Dim lngRowD As Long
If txtPN2.Value = "" Then
    MsgBox "First Criteria is Blank.Please Fill it first."
    Exit Sub
End If
If txtNM2.Value = "" Then
    MsgBox "Second Criteria is Blank.Please Fill it first."
    Exit Sub
End If
blnFindB = Not Worksheets("ATR-42").Range("B1:B10 ").Find(txtPN2.Value) Is Nothing
blnFindD = Not Worksheets("ATR-42").Range("D1:D10 ").Find(txtNM2.Value) Is Nothing
If blnFindB = True Then
lngRowB = Worksheets("ATR-42").Range("B1:B10 ").Find(txtPN2.Value).Row
End If
If blnFindD = True Then
lngRowD = Worksheets("ATR-42").Range("D1:D10 ").Find(txtNM2.Value).Row
End If
If blnFindB = True And blnFindD = False Or lngRowB <> lngRowD Then
    Label10.Caption = "Not Found!"
    Exit Sub
ElseIf blnFindB = False And blnFindD = True Or lngRowB <> lngRowD Then
    Label10.Caption = "Not Found!"
    Exit Sub
ElseIf blnFindB = False And blnFindD = False Or lngRowB <> lngRowD Then
    Label10.Caption = "Not Found!"
    Exit Sub
ElseIf blnFindB = True And blnFindD = True And lngRowB <> lngRowD Then
    Label10.Caption = "Not Found!"
    Exit Sub
End If

If lngRowB = lngRowD Then
txtPN1.Text = Worksheets("ATR-42").Range("B" & lngRowB)
txtNB1.Text = Worksheets("ATR-42").Range("C" & lngRowB)
txtNM1.Text = Worksheets("ATR-42").Range("D" & lngRowB)
txtL1.Text = Worksheets("ATR-42").Range("E" & lngRowB)
txtSM1.Text = Worksheets("ATR-42").Range("F" & lngRowB)
txtObs1.Text = Worksheets("ATR-42").Range("G" & lngRowB)
End If
End Sub

Code: 
Private Sub cmdModifica_Click()
Worksheets("ATR-42").Range("B" & lngRowB) = txtPN1.Text
Worksheets("ATR-42").Range("C" & lngRowB) = txtNB1.Text
Worksheets("ATR-42").Range("D" & lngRowB) = txtNM1.Text
Worksheets("ATR-42").Range("E" & lngRowB) = txtL1.Text
Worksheets("ATR-42").Range("F" & lngRowB) = txtSM1.Text
Worksheets("ATR-42").Range("G" & lngRowB) = txtObs1.Text
End Sub

use on form
 
Upvote 0
littleiitin said:
Hi ,

I am not able to see your picture.
Could you please tell me , is both the search criteria should be met? or only one criteria is sufficient? if second case is true then what if both are filled. which should get prefrence?
Click to expand...

Only one criteria is sufficient but I want at least one of them to be filled. Let me try to be more clear: I don't want either of them to be mandatory. What I want is that at least one should be filled or it should give a warning... something like "Fill at least one cell."

Also, I've tried youre code wich is very good but only has one issue: When I try searching for value, for example 4 it finds as a result the first value that contains 4. What I want to achieve is getting a code that can help me search for a specific value not part of a value. For example, if I try searching for 68-1448, I want it to only find this value written in this exact way and not something that contains it. In other words, I want to have to write exactly what I'm looking for so if I write 681448 I don't want it to find 68-1448 but just tell me it wasn't found. I hope I explaind myself sufficiently :)

The second code has an error but I'm trying to fix it and will come back with details.

Hope you can see this picture bellow this time :) and one again thank you very much for helping me!

e2.jpg
 
Upvote 0
I have changed whole module:

What I did: I have created a command button named cmdNextRecord. Please do the same and paste the below codes on your user form.

The button will appear if there are more than one records for the search.
Please try and let me know.


Code: 
Public lngRowB As Long
Dim varStoreRecords() As Variant
Dim varSplitRecords As Variant
Public j As Long
Private Sub cmdCauta_Click()
Dim blnFindB As Boolean
Dim blnFindD As Boolean
Dim lngRowD As Long
Dim rngCellB As Range
Dim rngCellD As Range
Dim i As Long
'Dim varStoreRecords() As Variant
'Dim varSplitRecords As Variant
i = 0
If txtPN2.Value = "" And txtNM2.Value = "" Then
    MsgBox "Both Criterias are Blank.Please Fill atleast one."
    Exit Sub
End If

If txtPN2.Value <> "" And txtNM2.Value = "" Then
    For Each rngCellB In Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
        If rngCellB.Value = txtPN2.Value Then
            lngRowB = rngCellB.Row
            txtPN1.Text = Worksheets("ATR-42").Range("B" & lngRowB)
            txtNB1.Text = Worksheets("ATR-42").Range("C" & lngRowB)
            txtNM1.Text = Worksheets("ATR-42").Range("D" & lngRowB)
            txtL1.Text = Worksheets("ATR-42").Range("E" & lngRowB)
            txtSM1.Text = Worksheets("ATR-42").Range("F" & lngRowB)
            txtObs1.Text = Worksheets("ATR-42").Range("G" & lngRowB)
            ReDim Preserve varStoreRecords(i + 1)
            varStoreRecords(i) = Worksheets("ATR-42").Range("B" & lngRowB) & "," & Worksheets("ATR-42").Range("C" & lngRowB) & "," & Worksheets("ATR-42").Range("D" & lngRowB) _
                                & "," & Worksheets("ATR-42").Range("E" & lngRowB) & "," & Worksheets("ATR-42").Range("F" & lngRowB) & "," & Worksheets("ATR-42").Range("G" & lngRowB)
                                
            
            i = i + 1
        End If
    Next
    If i <> 0 Then
    
        varSplitRecords = Split(varStoreRecords(0), ",")
        txtPN1.Text = varSplitRecords(0)
        txtNB1.Text = varSplitRecords(1)
        txtNM1.Text = varSplitRecords(2)
        txtL1.Text = varSplitRecords(3)
        txtSM1.Text = varSplitRecords(4)
        txtObs1.Text = varSplitRecords(5)
         
    End If
    If i > 1 Then
        cmdNextRecord.Visible = True
    End If
ElseIf txtPN2.Value = "" And txtNM2.Value <> "" Then
    For Each rngCellB In Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
        If rngCellB.Value = txtPN2.Value Then
            lngRowB = rngCellB.Row
            txtPN1.Text = Worksheets("ATR-42").Range("B" & lngRowB)
            txtNB1.Text = Worksheets("ATR-42").Range("C" & lngRowB)
            txtNM1.Text = Worksheets("ATR-42").Range("D" & lngRowB)
            txtL1.Text = Worksheets("ATR-42").Range("E" & lngRowB)
            txtSM1.Text = Worksheets("ATR-42").Range("F" & lngRowB)
            txtObs1.Text = Worksheets("ATR-42").Range("G" & lngRowB)
            ReDim Preserve varStoreRecords(i + 1)
            varStoreRecords(i) = Worksheets("ATR-42").Range("B" & lngRowB) & "," & Worksheets("ATR-42").Range("C" & lngRowB) & "," & Worksheets("ATR-42").Range("D" & lngRowB) _
                                & "," & Worksheets("ATR-42").Range("E" & lngRowB) & "," & Worksheets("ATR-42").Range("F" & lngRowB) & "," & Worksheets("ATR-42").Range("G" & lngRowB)
                                
            
            i = i + 1
        End If
    Next
    If i <> 0 Then
    
        varSplitRecords = Split(varStoreRecords(0), ",")
        txtPN1.Text = varSplitRecords(0)
        txtNB1.Text = varSplitRecords(1)
        txtNM1.Text = varSplitRecords(2)
        txtL1.Text = varSplitRecords(3)
        txtSM1.Text = varSplitRecords(4)
        txtObs1.Text = varSplitRecords(5)
          
    End If
    
    If i > 1 Then
        cmdNextRecord.Visible = True
    End If
    
ElseIf txtPN2.Value <> "" And txtNM2.Value <> "" Then
    For Each rngCellB In Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
        If rngCellB.Value = txtPN2.Value And rngCellB.Offset(, 2).Value = txtNM2.Value Then
            lngRowB = rngCellB.Row
            txtPN1.Text = Worksheets("ATR-42").Range("B" & lngRowB)
            txtNB1.Text = Worksheets("ATR-42").Range("C" & lngRowB)
            txtNM1.Text = Worksheets("ATR-42").Range("D" & lngRowB)
            txtL1.Text = Worksheets("ATR-42").Range("E" & lngRowB)
            txtSM1.Text = Worksheets("ATR-42").Range("F" & lngRowB)
            txtObs1.Text = Worksheets("ATR-42").Range("G" & lngRowB)
            ReDim Preserve varStoreRecords(i + 1)
            varStoreRecords(i) = Worksheets("ATR-42").Range("B" & lngRowB) & "," & Worksheets("ATR-42").Range("C" & lngRowB) & "," & Worksheets("ATR-42").Range("D" & lngRowB) _
                                & "," & Worksheets("ATR-42").Range("E" & lngRowB) & "," & Worksheets("ATR-42").Range("F" & lngRowB) & "," & Worksheets("ATR-42").Range("G" & lngRowB)
                                
            
            i = i + 1
        End If
    Next
    If i <> 0 Then
    
        varSplitRecords = Split(varStoreRecords(0), ",")
        txtPN1.Text = varSplitRecords(0)
        txtNB1.Text = varSplitRecords(1)
        txtNM1.Text = varSplitRecords(2)
        txtL1.Text = varSplitRecords(3)
        txtSM1.Text = varSplitRecords(4)
        txtObs1.Text = varSplitRecords(5)
    End If
    
    If i > 1 Then
     cmdNextRecord.Visible = True
    End If
    
End If
If i = 0 Then
 Label10.Caption = "Not Found!"
End If

End Sub
Code: 
Private Sub cmdModifica_Click()
Worksheets("ATR-42").Range("B" & lngRowB) = txtPN1.Text
Worksheets("ATR-42").Range("C" & lngRowB) = txtNB1.Text
Worksheets("ATR-42").Range("D" & lngRowB) = txtNM1.Text
Worksheets("ATR-42").Range("E" & lngRowB) = txtL1.Text
Worksheets("ATR-42").Range("F" & lngRowB) = txtSM1.Text
Worksheets("ATR-42").Range("G" & lngRowB) = txtObs1.Text
End Sub
Code: 
Private Sub cmdNextRecord_Click()
    j = j + 1
        varSplitRecords = Split(varStoreRecords(j), ",")
        txtPN1.Text = varSplitRecords(0)
        txtNB1.Text = varSplitRecords(1)
        txtNM1.Text = varSplitRecords(2)
        txtL1.Text = varSplitRecords(3)
        txtSM1.Text = varSplitRecords(4)
        txtObs1.Text = varSplitRecords(5)
End Sub

Code: 
Private Sub UserForm_Activate()
cmdNextRecord.Visible = False
End Sub
 
Upvote 0
with some corrections:

Code: 
Public lngRowB As Long
Dim varStoreRecords() As Variant
Dim varSplitRecords As Variant
Public j As Long
Private Sub cmdCauta_Click()
Dim blnFindB As Boolean
Dim blnFindD As Boolean
Dim lngRowD As Long
Dim rngCellB As Range
Dim rngCellD As Range
Dim i As Long
'Dim varStoreRecords() As Variant
'Dim varSplitRecords As Variant
i = 0
If txtPN2.Value = "" And txtNM2.Value = "" Then
    MsgBox "Both Criterias are Blank.Please Fill atleast one."
    Exit Sub
End If
 
If txtPN2.Value <> "" And txtNM2.Value = "" Then
    For Each rngCellB In Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
        If CStr(rngCellB.Value) = txtPN2.Value Then
            lngRowB = rngCellB.Row
            txtPN1.Text = Worksheets("ATR-42").Range("B" & lngRowB)
            txtNB1.Text = Worksheets("ATR-42").Range("C" & lngRowB)
            txtNM1.Text = Worksheets("ATR-42").Range("D" & lngRowB)
            txtL1.Text = Worksheets("ATR-42").Range("E" & lngRowB)
            txtSM1.Text = Worksheets("ATR-42").Range("F" & lngRowB)
            txtObs1.Text = Worksheets("ATR-42").Range("G" & lngRowB)
            ReDim Preserve varStoreRecords(i + 1)
            varStoreRecords(i) = Worksheets("ATR-42").Range("B" & lngRowB) & "," & Worksheets("ATR-42").Range("C" & lngRowB) & "," & Worksheets("ATR-42").Range("D" & lngRowB) _
                                & "," & Worksheets("ATR-42").Range("E" & lngRowB) & "," & Worksheets("ATR-42").Range("F" & lngRowB) & "," & Worksheets("ATR-42").Range("G" & lngRowB)
 
 
            i = i + 1
        End If
    Next
    If i <> 0 Then
 
        varSplitRecords = Split(varStoreRecords(0), ",")
        txtPN1.Text = varSplitRecords(0)
        txtNB1.Text = varSplitRecords(1)
        txtNM1.Text = varSplitRecords(2)
        txtL1.Text = varSplitRecords(3)
        txtSM1.Text = varSplitRecords(4)
        txtObs1.Text = varSplitRecords(5)
 
    End If
    If i > 1 Then
        cmdNextRecord.Visible = True
    End If
ElseIf txtPN2.Value = "" And txtNM2.Value <> "" Then
    For Each rngCellB In Range("D1:D" & Range("D" & Rows.Count).End(xlUp).Row)
        If CStr(rngCellB.Value) = (txtNM2.Value) Then
            lngRowB = rngCellB.Row
            txtPN1.Text = Worksheets("ATR-42").Range("B" & lngRowB)
            txtNB1.Text = Worksheets("ATR-42").Range("C" & lngRowB)
            txtNM1.Text = Worksheets("ATR-42").Range("D" & lngRowB)
            txtL1.Text = Worksheets("ATR-42").Range("E" & lngRowB)
            txtSM1.Text = Worksheets("ATR-42").Range("F" & lngRowB)
            txtObs1.Text = Worksheets("ATR-42").Range("G" & lngRowB)
            ReDim Preserve varStoreRecords(i + 1)
            varStoreRecords(i) = Worksheets("ATR-42").Range("B" & lngRowB) & "," & Worksheets("ATR-42").Range("C" & lngRowB) & "," & Worksheets("ATR-42").Range("D" & lngRowB) _
                                & "," & Worksheets("ATR-42").Range("E" & lngRowB) & "," & Worksheets("ATR-42").Range("F" & lngRowB) & "," & Worksheets("ATR-42").Range("G" & lngRowB)
 
 
            i = i + 1
        End If
    Next
    If i <> 0 Then
 
        varSplitRecords = Split(varStoreRecords(0), ",")
        txtPN1.Text = varSplitRecords(0)
        txtNB1.Text = varSplitRecords(1)
        txtNM1.Text = varSplitRecords(2)
        txtL1.Text = varSplitRecords(3)
        txtSM1.Text = varSplitRecords(4)
        txtObs1.Text = varSplitRecords(5)
 
    End If
 
    If i > 1 Then
        cmdNextRecord.Visible = True
    End If
 
ElseIf txtPN2.Value <> "" And txtNM2.Value <> "" Then
    For Each rngCellB In Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
        If (CStr(rngCellB.Value) = txtPN2.Value) And (CStr(rngCellB.Offset(, 2).Value) = txtNM2.Value) Then
            lngRowB = rngCellB.Row
            txtPN1.Text = Worksheets("ATR-42").Range("B" & lngRowB)
            txtNB1.Text = Worksheets("ATR-42").Range("C" & lngRowB)
            txtNM1.Text = Worksheets("ATR-42").Range("D" & lngRowB)
            txtL1.Text = Worksheets("ATR-42").Range("E" & lngRowB)
            txtSM1.Text = Worksheets("ATR-42").Range("F" & lngRowB)
            txtObs1.Text = Worksheets("ATR-42").Range("G" & lngRowB)
            ReDim Preserve varStoreRecords(i + 1)
            varStoreRecords(i) = Worksheets("ATR-42").Range("B" & lngRowB) & "," & Worksheets("ATR-42").Range("C" & lngRowB) & "," & Worksheets("ATR-42").Range("D" & lngRowB) _
                                & "," & Worksheets("ATR-42").Range("E" & lngRowB) & "," & Worksheets("ATR-42").Range("F" & lngRowB) & "," & Worksheets("ATR-42").Range("G" & lngRowB)
 
 
            i = i + 1
        End If
    Next
    If i <> 0 Then
 
        varSplitRecords = Split(varStoreRecords(0), ",")
        txtPN1.Text = varSplitRecords(0)
        txtNB1.Text = varSplitRecords(1)
        txtNM1.Text = varSplitRecords(2)
        txtL1.Text = varSplitRecords(3)
        txtSM1.Text = varSplitRecords(4)
        txtObs1.Text = varSplitRecords(5)
    End If
 
    If i > 1 Then
     cmdNextRecord.Visible = True
    End If
 
End If
If i = 0 Then
 Label10.Caption = "Not Found!"
End If
 
End Sub
Private Sub cmdModifica_Click()
Worksheets("ATR-42").Range("B" & lngRowB) = txtPN1.Text
Worksheets("ATR-42").Range("C" & lngRowB) = txtNB1.Text
Worksheets("ATR-42").Range("D" & lngRowB) = txtNM1.Text
Worksheets("ATR-42").Range("E" & lngRowB) = txtL1.Text
Worksheets("ATR-42").Range("F" & lngRowB) = txtSM1.Text
Worksheets("ATR-42").Range("G" & lngRowB) = txtObs1.Text
End Sub
Code: 
Private Sub cmdNextRecord_Click()
    j = j + 1
        If j <= UBound(varStoreRecords) - 1 Then
            varSplitRecords = Split(varStoreRecords(j), ",")
            txtPN1.Text = varSplitRecords(0)
            txtNB1.Text = varSplitRecords(1)
            txtNM1.Text = varSplitRecords(2)
            txtL1.Text = varSplitRecords(3)
            txtSM1.Text = varSplitRecords(4)
            txtObs1.Text = varSplitRecords(5)
        Else
        MsgBox "No More Records"
        End If
End Sub
Code: 
Private Sub UserForm_Activate()
cmdNextRecord.Visible = False
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Search Function Loads TextBox's Values, but I need user not to change those tb
Replies
2
Views
839
Micron
M
T
  • Question
I am needing help making a macro that will save me time in my job
Replies
0
Views
639
TcHawker
T
D
  • Question
Can I get some help with this vba code to move a selected row to a specific sheet
Replies
2
Views
562
dpaton05
D
J
  • Question
Can I get help troubleshooting this macro?
Replies
5
Views
1K
rlv01
R
J
  • Question
Please can some one help I been Trying to Wrap my head around this.
Replies
1
Views
384
jpt145
J

Forum statistics

Threads
1,215,757
Messages
6,126,695
Members
449,331
Latest member
smckenzie2016

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