Two or more VBA in one worksheet

Jennifer Van

New Member
Joined
Apr 22, 2022
Messages
41
Office Version
  1. 2016
Platform
  1. Windows
I already have a VBA which copies a line from worksheet Loan Request Return to another worksheet called WaitList if cell Q says yes.

What I need now is if another cell "AB" says Yes, to copy the cell to another worksheet "Repairs Remove"

And if possible, columns K,L,M data (if data is in there) only be copied to a sheet called Equipment Library and not only to an empty cell, it goes to the cell which holds the same UID (UniqueID) which then shows that the equipment is on loan etc?

Thank you, I know this is a lot to ask
 
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.CountLarge > 1 Then Exit Sub

' See if column is Q (17) changed to "Yes" and row >=5
If Target.Column = 16 And Target = "Yes" And Target.Row >= 5 Then
' Copy columns A:Q and paste to WaitList sheet
Range(Cells(Target.Row, "A"), Cells(Target.Row, "P")).Copy Sheets("WaitList").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 4/23/2022 3:24:28 AM EDT
If Target.Address = "$AB$6" Then
Dim r As Long
r = Target.Row
Dim Lastrow As Long
Lastrow = Sheets("Repairs Remove").Cells(Rows.Count, "L").End(xlUp).Row + 1

If Target.Value = "Yes" Then
Cells(r, "L").Resize(, 3).Copy Sheets("Repairs Remove").Cells(Lastrow, "L")
End If

End If

End Sub
 
Upvote 0

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.
Try this:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Modified  4/23/2022  4:51:12 AM  EDT

If Target.CountLarge > 1 Then Exit Sub

' See if column is Q (17) changed to "Yes" and row >=5
If Target.Column = 16 And Target = "Yes" And Target.Row >= 5 Then
' Copy columns A:Q and paste to WaitList sheet
Range(Cells(Target.Row, "A"), Cells(Target.Row, "P")).Copy Sheets("WaitList").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

End If


'Modified  4/23/2022  4:51:12 AM  EDT
If Target.Address = "$AB$6" Then
Dim r As Long
r = Target.Row
Dim Lastrow As Long
Lastrow = Sheets("Repairs Remove").Cells(Rows.Count, "L").End(xlUp).Row + 1

If Target.Value = "Yes" Then
    Cells(r, "L").Resize(, 3).Copy Sheets("Repairs Remove").Cells(Lastrow, "L")
End If
End If

End Sub
 
Upvote 0
Sorry I think I have really confused the issue here ....
There are three codes I want in the same worksheet.
I have the first one:

Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 4/23/2022 4:51:12 AM EDT

If Target.CountLarge > 1 Then Exit Sub

' See if column is Q (17) changed to "Yes" and row >=5
If Target.Column = 16 And Target = "Yes" And Target.Row >= 5 Then
' Copy columns A:Q and paste to WaitList sheet
Range(Cells(Target.Row, "A"), Cells(Target.Row, "P")).Copy Sheets("WaitList").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

End If

This moves data in Columns A to P (all rows) into the WaitList sheet - adds to last entry that is already there.

I want another code to move any data found in Columns L6,M6 and N6 only - if cell AB6 says yes to worksheet Repairs Remove. I want this also to copy to start at column A in the Repair Remove worksheet (not row L which it is doing now)

The other code I want is the information that I put into rows v6,w6,x6,y6 to be copied and placed into the worksheet Equipment Library. The tricky thing here is that I don't want it just copied into a blank cell in this worksheet, I want it copied into cells J,K,L,M and to make it even harder - the copied data needs to find to correct row - which is identified by the UID column - which in the Loan Request Return worksheet (master) is found in column M and in the Equipment Library worksheet it is in column c

Does all this make sense?????

Jen
 
Upvote 0
No. I have written you one code which I'm not sure you said worked by itself.
Then you said you had two codes in the same sheet and showed them to me.
And you did not say if those two codes worked OK.
But now your saying you have a third code in the sheet which you did not show me.
And then you start explaining what you want another code to do.

I would think you should try each piece of code by itself to just see if it works properly.
And then add in the second code and see if those two codes work OK together.

And on and on.
This may be getting to complicated for me.
And your asking for another code to be written which is hard for me to understand.
This is beyond my knowledgebase.
I will continue to monitor this thread to see what I can learn.
 
Upvote 0
I really like helping but it's hard when you don't give all the details at the beginning.

So are the first two codes I put in my last script working properly?
Yes Or No please answer that question before we move on.

Now if you say yes tell me what else do you need. Are we talking about one more script or two more scripts?
 
Upvote 0
I really like helping but it's hard when you don't give all the details at the beginning.

So are the first two codes I put in my last script working properly?
Yes Or No please answer that question before we move on.

Now if you say yes tell me what else do you need. Are we talking about one more script or two more scripts?
No, your second script did not work
Jen
 
Upvote 0
No, your second script did not work
Jen
Show me everything you have on your sheet.

See the reason is probable because you have more then one script trying to run.
Did the script run if you only had that script in the sheet?
 
Upvote 0
Show me everything you have on your sheet.

See the reason is probable because you have more then one script trying to run.
Did the script run if you only had that script in the sheet?
Hi
No it does not, either on its own and with the first script below
Thanks
Jen



Private Sub Worksheet_Change(ByVal Target As Range)
'Modified 4/23/2022 4:51:12 AM EDT

If Target.CountLarge > 1 Then Exit Sub

' See if column is Q (17) changed to "Yes" and row >=5
If Target.Column = 16 And Target = "Yes" And Target.Row >= 5 Then
' Copy columns A:Q and paste to WaitList sheet
Range(Cells(Target.Row, "A"), Cells(Target.Row, "P")).Copy Sheets("WaitList").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

End If


'Modified 4/23/2022 4:51:12 AM EDT
If Target.Address = "$AB$6" Then
Dim r As Long
r = Target.Row
Dim Lastrow As Long
Lastrow = Sheets("Repairs Remove").Cells(Rows.Count, "L").End(xlUp).Row + 1

If Target.Value = "Yes" Then
Cells(r, "L").Resize(, 3).Copy Sheets("Repairs Remove").Cells(Lastrow, "L")
End If
End If

End Sub
 
Upvote 0
I have played around with this and got it working - it was r was a target row and we were targeting a column so I changed it to c and it worked!!!!!!!

So can I ask about the third action?

This one is working on the same Loan Request Return worksheet and we I complete rows v,w,x,y (current status) with data, I want this data copied to the Equipment Library sheet.
However, not just copied to the next blank row - I want it to go into particular rows in the sheet - rows J,K,L,M and also the data needs to find the correct row to copy to depending on a unique value.

For instance - if I am logging out a wheelchair with unique ID 1234 on the loan request sheet and put in all the loan information on this sheet, I want the current status information to automatically update the equipment log showing where the wheelchair is, who has it and when it is due back.

When I loan out the wheelchair 1234 next time, the new information will just replace the information that is in there from the old loaner.

Does this make sense or have I explained it badly?
Jen
 
Upvote 0
Hello Jennifer,

In an effort to possibly help out, try the codes as modified below:-

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
        
        If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Columns(17)) Is Nothing And Target.Row >= 5 Then
             If Target.Value = "Yes" Then
                   Range(Cells(Target.Row, "A"), Cells(Target.Row, "P")).Copy Sheets("WaitList").Range("A" & Rows.Count).End(3)(2)
             End If
        End If

        If Not Intersect(Target, Columns(28)) Is Nothing And Target.Row >= 5 Then
              Dim tr As Long: tr = Target.Row
              If Target.Value = "Yes" Then
                    Cells(tr, "L").Resize(, 3).Copy Sheets("Repairs Remove").Range("A" & Rows.Count).End(3)(2)
              End If
        End If

End Sub

These two codes placed in the one worksheet module(Loan Request Return sheet module), should do as you were hoping based on your opening post and post #13. They are Worksheet_Change event codes based on the "Yes" criteria.

The following code, again placed in the Loan Request Return sheet module, should finish the puzzle for you based on your post #19:-

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

        If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Columns(13)) Is Nothing And Target.Row >= 5 Then
        
        Dim Sval As Range, wsEL As Worksheet, wsLRR As Worksheet
        
        Set wsLRR = Sheets("Loan Request Return")
        Set wsEL = Sheets("Equipment Library")
        Set Sval = wsEL.Columns("C:C").Find(Target.Value)
        
        If Target.Value = Sval.Value Then
        Target.Offset(, 9).Resize(, 4).Copy Sval.Offset(, 7)
        End If
        End If

End Sub

As I didn't know how you wanted the code to execute, I decided that a Double Click event code may be just what you need. Hence, once you have entered your data in the Loan Request Return sheet, just double click on the unique ID for the relevant row. Make sure that the double click is your last action per row.
The code should transfer the required data to the Equipment Library sheet and to the intended row by matching the unique IDs.

I've created a mock-up work book for you here. The codes are all implemented in the workbook so have a play with it just to see how it works.

I hope that this helps.

Cheerio,
vcoolio.
 
Upvote 0

Forum statistics

Threads
1,216,518
Messages
6,131,121
Members
449,624
Latest member
MandlaMan

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