Adding Multiple VBA Codes to the Same Sheet

qqtest · Oct 25th 2018

I am attempting to create a code that copies a row to another sheet based on selections in columns G and F. I cannot figure out how to run both at once!

I am attempting to run this code:

Code

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
If Target = "AG" Then
Target.EntireRow.Copy Sheets("AG").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
If Target = "RF" Then
Target.EntireRow.Copy Sheets("RF").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
If Target = "EH" Then
Target.EntireRow.Copy Sheets("EH").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
If Target = "JH" Then
Target.EntireRow.Copy Sheets("JH").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
If Target = "NL" Then
Target.EntireRow.Copy Sheets("NL").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
If Target = "SP" Then
Target.EntireRow.Copy Sheets("SP").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
If Target = "LS" Then
Target.EntireRow.Copy Sheets("LS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
If Target = "DS" Then
Target.EntireRow.Copy Sheets("DS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub
If Target = "RW" Then
Target.EntireRow.Copy Sheets("RW").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If


End Sub

Display More

--------------------------------------------------------------------------

At the same time as running the code below:

Code

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
If Target = "Clouded" Then
Target.EntireRow.Copy Sheets("Radi").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub
If Target = "Faxed" Then
Target.EntireRow.Copy Sheets("Fax").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
End Sub

----------------------------------------------------------------------------

How can I run both at the same time?

**alansidman** · Oct 25th 2018

Code Tags Added
Your post does not comply with our Forum RULES. Use code tags around code.

Posting code between

Code

tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window.

(I have added them for you today. Please take a few minutes to read all Forum Rules and comply in the future.)

**alansidman** · Oct 25th 2018

You can not run them at the same time, but you could have another macro that calls each one consecutively.

Something like this:

Code

Sub RunAll()    
Call Macro1    
Call Macro2    
Call Macro3
End Sub

change the macro names as needed.

**Carim** · Oct 25th 2018

Hello,

You could test the following :

Code

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F:G")) Is Nothing Then Exit Sub
  If Target.Column = 6 Then
      Target.EntireRow.Copy Sheets(Target.Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
  Else
      If Target = "Clouded" Then
        Target.EntireRow.Copy Sheets("Radi").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
      ElseIf Target = "Faxed" Then
        Target.EntireRow.Copy Sheets("Fax").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
      End If
  End If
End Sub

Display More

Hope this will help

davesexcel · Oct 25th 2018

You cannot use `If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub` if you intend on using additional columns for target ranges.

Code

Private Sub Worksheet_Change(ByVal Target As Range)
'If Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub can't have this if you want to use other columns
if target.count>1 then exit sub


    If Target.Column = 7 Then
        If Target = "AG" Then Target.EntireRow.Copy Sheets("AG").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Target = "RF" Then Target.EntireRow.Copy Sheets("RF").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Target = "EH" Then Target.EntireRow.Copy Sheets("EH").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Target = "JH" Then Target.EntireRow.Copy Sheets("JH").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Target = "NL" Then Target.EntireRow.Copy Sheets("NL").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Target = "SP" Then Target.EntireRow.Copy Sheets("SP").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Target = "LS" Then Target.EntireRow.Copy Sheets("LS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Target = "DS" Then Target.EntireRow.Copy Sheets("DS").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Target = "RW" Then Target.EntireRow.Copy Sheets("RW").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If


    If Target.Column = 6 Then
        If Target = "Clouded" Then Target.EntireRow.Copy Sheets("Radi").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        If Target = "Faxed" Then Target.EntireRow.Copy Sheets("Fax").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
    End If




End Sub

Display More

graha_karya · Oct 26th 2018

Code

Private Sub Worksheet_Change(ByVal Target As Range)
 dim s as string
if target.count > 1 then exit sub


 Select case Target.column
     case 7  
      s ="AG","RF","EH","JH","NL","SP","LS","DS","RW"
      If Instr(s,Target,1)  Then Target.EntireRow.Copy Sheets(cstr(target.value)).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)


     Case 6  


      If Target = "Clouded" Then Target.EntireRow.Copy Sheets("Radi").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)  
      If Target = "Faxed" Then Target.EntireRow.Copy Sheets("Fax").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)


   End select
End Sub

Display More

**Carim** · Oct 28th 2018

Hello,

Let's hope qqtest will be pleased by the multiple solutions proposed ... ::smile:

Adding Multiple VBA Codes to the Same Sheet

Participate now!

Share