How to run a code once to different workbook?

S

Sherli

New Member
Joined
Apr 27, 2020
Messages
15
Office Version
  1. 2016
Platform
  1. Windows
Hi, all. I am Beginner in VBA. I have 2 workbook, which is book 1 & book2 and inside the file have 1 worksheet for each. I have run the code that I have attach below and it show duplicate action result in one file and the other file still remain the same (does not do the action that I have wrote in my code). May I know how can I run the code once to do the action I need for two different workbook? Thanks in advanced.


VBA Code: 
'Run two file at once
Sub Try()
    Dim wb1 As Workbook
    Dim ws1 As Worksheet
    Dim x As Long, y As Long, z As Long    
    
    Set wb1 = Workbooks("B1_Book")
    
    With wb1.Worksheets("Sheet1")
        
        'Trim Column E & Column B
        x = .Range("B2").End(xlDown).Row
        y = .Range("E2").End(xlDown).Row
        z = .Range("F2").End(xlDown).Row
        
        
        For a = 2 To x
            .Cells(a, "B").Value = Trim(.Cells(a, "B").Value)
        Next a
        For b = 2 To y
            .Cells(b, "E").Value = Trim(.Cells(b, "E").Value)
        Next b
        
        'Trim cell G1
        Range("G1").Value = Trim(Range("G1"))
        
        'Change cell format
        Columns("N:N").NumberFormat = "@"
        
        'Insert Column
        Range("F1").EntireColumn.Insert
        
        'Insert Name
        Range("F1").Select
        ActiveCell.FormulaR1C1 = "Number"
        
        
        'Pair data from two column
        For c = 2 To z
            .Cells(c, "F").Value = Cells(c, "E") & Cells(c, "B")
        Next c
        
        'Filter and delete
        .Range("A1:S1").AutoFilter 9, Array("Unfulfilled", "New"), xlFilterValues
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
        .Range("A1:S1").AutoFilter 11, ""
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
        .Range("A1:S1").AutoFilter 18, "Y"
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
    End With
    
    Dim wb2 As Workbook
    Dim ws2 As Worksheet
    Dim x1 As Long, y1 As Long, z1 As Long
    
    Set wb2 = Workbooks("B2_Book")
    
    With wb2.Worksheets("Sheet1")
        
        'Trim Column E & Column B
        x1 = .Range("B2").End(xlDown).Row
        y1 = .Range("E2").End(xlDown).Row
        z1 = .Range("F2").End(xlDown).Row
        
        
        For a1 = 2 To x1
            .Cells(a1, "B").Value = Trim(.Cells(a1, "B").Value)
        Next a1
        For b1 = 2 To y1
            .Cells(b1, "E").Value = Trim(.Cells(b1, "E").Value)
        Next b1
        
        'Trim cell G1
        Range("G1").Value = Trim(Range("G1"))
        
        'Change cell format
        Columns("N:N").NumberFormat = "@"
        
        'Insert Column
        Range("F1").EntireColumn.Insert
        
        'Insert Name
        Range("F1").Select
        ActiveCell.FormulaR1C1 = "Number"
        
        
        'Pair data from two column
        For c1 = 2 To z1
            .Cells(c1, "F").Value = Cells(c1, "E") & Cells(c1, "B")
        Next c1
        
        'Filter and delete
        .Range("A1:S1").AutoFilter 9, "Unfulfilled"
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
        .Range("A1:S1").AutoFilter 11, ""
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
        .Range("A1:S1").AutoFilter 17, "Y"
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
    End With
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Sherli said:
May I know how can I run the code once to do the action I need for two different workbook?
Click to expand...
Targetting two different workbooks / worksheets in ONE action cannot be done so your code have to run twice. In these cases VBA offers you to write procedures (subs or functions) that accept arguments. I removed the duplicate code and refurbished your code in a way it accepts a worksheet object as an argument. A new procedure is introduced which calls the refurbished one.
VBA Code: 
Public Sub RunTwice()

    Dim oWs     As Worksheet

    Set oWs = Workbooks("B1_Book").Worksheets("Sheet1")
    Call DoSomeAction(oWs)

    ' call procedure once more acting on a sheet within ANOTHER workbook
    Set oWs = Workbooks("B2_Book").Worksheets("Sheet1")
    Call DoSomeAction(oWs)

    Set oWs = Nothing

End Sub


Public Sub DoSomeAction(ByVal argSht As Worksheet)

    Dim a As Long, b As Long, c As Long
    Dim x As Long, y As Long, z As Long

    If Not argSht Is Nothing Then
        With argSht
    
            'Trim Column E & Column B
            x = .Range("B2").End(xlDown).Row
            y = .Range("E2").End(xlDown).Row
            z = .Range("F2").End(xlDown).Row
    
            For a = 2 To x
                .Cells(a, "B").Value = Trim(.Cells(a, "B").Value)
            Next a
            For b = 2 To y
                .Cells(b, "E").Value = Trim(.Cells(b, "E").Value)
            Next b
    
            'Trim cell G1
            .Range("G1").Value = Trim(Range("G1"))
    
            'Change cell format
            .Columns("N:N").NumberFormat = "@"
    
            'Insert Column
            .Range("F1").EntireColumn.Insert
    
            'Insert Name
            .Range("F1").FormulaR1C1 = "Number"
    
            'Pair data from two column
            For c = 2 To z
                .Cells(c, "F").Value = Cells(c, "E") & Cells(c, "B")
            Next c
    
            'Filter and delete
            .Range("A1:S1").AutoFilter 9, Array("Unfulfilled", "New"), xlFilterValues
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .AutoFilterMode = False
            .Range("A1:S1").AutoFilter 11, ""
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .AutoFilterMode = False
            .Range("A1:S1").AutoFilter 18, "Y"
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .AutoFilterMode = False
            
        End With
    End If
End Sub
 
Upvote 0
You haven't qualified all of the ranges, so a lot of your code is working on the activesheet.
Try
VBA Code: 
Sub Try()
    Dim wb1 As Workbook
    Dim ws1 As Worksheet
    Dim x As Long, y As Long, z As Long
    
    Set wb1 = Workbooks("B1_Book")
    
    With wb1.Worksheets("Sheet1")
        
        'Trim Column E & Column B
        x = .Range("B2").End(xlDown).Row
        y = .Range("E2").End(xlDown).Row
        z = .Range("F2").End(xlDown).Row
        
        
        For a = 2 To x
            .Cells(a, "B").Value = Trim(.Cells(a, "B").Value)
        Next a
        For b = 2 To y
            .Cells(b, "E").Value = Trim(.Cells(b, "E").Value)
        Next b
        
        'Trim cell G1
        .Range("G1").Value = Trim(.Range("G1"))
        
        'Change cell format
        .Columns("N:N").NumberFormat = "@"
        
        'Insert Column
        .Range("F1").EntireColumn.Insert
        
        'Insert Name
        .Range("F1").Value = "Number"
        
        
        'Pair data from two column
        For c = 2 To z
            .Cells(c, "F").Value = .Cells(c, "E") & .Cells(c, "B")
        Next c
        
        'Filter and delete
        .Range("A1:S1").AutoFilter 9, Array("Unfulfilled", "New"), xlFilterValues
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
        .Range("A1:S1").AutoFilter 11, ""
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
        .Range("A1:S1").AutoFilter 18, "Y"
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
    End With
    
    Dim wb2 As Workbook
    Dim ws2 As Worksheet
    Dim x1 As Long, y1 As Long, z1 As Long
    
    Set wb2 = Workbooks("B2_Book")
    
    With wb2.Worksheets("Sheet1")
        
        'Trim Column E & Column B
        x1 = .Range("B2").End(xlDown).Row
        y1 = .Range("E2").End(xlDown).Row
        z1 = .Range("F2").End(xlDown).Row
        
        
        For a1 = 2 To x1
            .Cells(a1, "B").Value = Trim(.Cells(a1, "B").Value)
        Next a1
        For b1 = 2 To y1
            .Cells(b1, "E").Value = Trim(.Cells(b1, "E").Value)
        Next b1
        
        'Trim cell G1
        .Range("G1").Value = Trim(.Range("G1"))
        
        'Change cell format
        .Columns("N:N").NumberFormat = "@"
        
        'Insert Column
        .Range("F1").EntireColumn.Insert
        
        'Insert Name
        .Range("F1").Value = "Number"
        
        
        'Pair data from two column
        For c1 = 2 To z1
            .Cells(c1, "F").Value = .Cells(c1, "E") & .Cells(c1, "B")
        Next c1
        
        'Filter and delete
        .Range("A1:S1").AutoFilter 9, "Unfulfilled"
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
        .Range("A1:S1").AutoFilter 11, ""
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
        .Range("A1:S1").AutoFilter 17, "Y"
        .AutoFilter.Range.Offset(1).EntireRow.Delete
        .AutoFilterMode = False
    End With
End Sub
 
Upvote 0
GWteB said:
Targetting two different workbooks / worksheets in ONE action cannot be done so your code have to run twice. In these cases VBA offers you to write procedures (subs or functions) that accept arguments. I removed the duplicate code and refurbished your code in a way it accepts a worksheet object as an argument. A new procedure is introduced which calls the refurbished one.
VBA Code: 
Public Sub RunTwice()

    Dim oWs     As Worksheet

    Set oWs = Workbooks("B1_Book").Worksheets("Sheet1")
    Call DoSomeAction(oWs)

    ' call procedure once more acting on a sheet within ANOTHER workbook
    Set oWs = Workbooks("B2_Book").Worksheets("Sheet1")
    Call DoSomeAction(oWs)

    Set oWs = Nothing

End Sub


Public Sub DoSomeAction(ByVal argSht As Worksheet)

    Dim a As Long, b As Long, c As Long
    Dim x As Long, y As Long, z As Long

    If Not argSht Is Nothing Then
        With argSht
   
            'Trim Column E & Column B
            x = .Range("B2").End(xlDown).Row
            y = .Range("E2").End(xlDown).Row
            z = .Range("F2").End(xlDown).Row
   
            For a = 2 To x
                .Cells(a, "B").Value = Trim(.Cells(a, "B").Value)
            Next a
            For b = 2 To y
                .Cells(b, "E").Value = Trim(.Cells(b, "E").Value)
            Next b
   
            'Trim cell G1
            .Range("G1").Value = Trim(Range("G1"))
   
            'Change cell format
            .Columns("N:N").NumberFormat = "@"
   
            'Insert Column
            .Range("F1").EntireColumn.Insert
   
            'Insert Name
            .Range("F1").FormulaR1C1 = "Number"
   
            'Pair data from two column
            For c = 2 To z
                .Cells(c, "F").Value = Cells(c, "E") & Cells(c, "B")
            Next c
   
            'Filter and delete
            .Range("A1:S1").AutoFilter 9, Array("Unfulfilled", "New"), xlFilterValues
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .AutoFilterMode = False
            .Range("A1:S1").AutoFilter 11, ""
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .AutoFilterMode = False
            .Range("A1:S1").AutoFilter 18, "Y"
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .AutoFilterMode = False
           
        End With
    End If
End Sub
Click to expand...
Hi, GwteB. Thanks for your help. The code is work well with same action for each file once. But may I know how to run different action for each each worksheet for each workbook? Because there is a bit different action need to do for each worksheet.
 
Upvote 0
You are welcome and thanks for letting me know.

Sherli said:
But may I know how to run different action for each each worksheet for each workbook? Because there is a bit different action need to do for each worksheet.
Click to expand...
I don't quite understand what you mean. Your code as of post #1 was intended to perform the same action on two identical worksheets. In this context however, it does not matter whether those two identical worksheets are in the same workbook or each in a different workbook. In case you don't have identical worksheets you will have to write specific code for each worksheet, depending on what your goal is and what actions need to be performed. Where circumstances cause identical code sequences, there is the possibility to split that code from the main procedure and to include it in a separate procedure. The separate procedure can then be called by the main procedure or by whatever procedure you like as many times as you need. My post #2 code is an example of that.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question
VBA Questions - Copying dynamic data from one tab to another and deleting filtered rows
Replies
1
Views
187
DanteAmor
DanteAmor
S
  • Solved
Tweak Macro that Imports specific table columns from a different workbook to filter a column first
Replies
4
Views
170
sspatriots
S
K
  • Question
sum without duplicate calculation
Replies
1
Views
266
kelvin_9
K
G
  • Question
Copying and pasting between two workbooks
Replies
1
Views
511
rlv01
R
E
  • Question
Filtering values from data source and pasting it into a second workbook
2
Replies
17
Views
912
kevin9999
K

Forum statistics

Threads
1,215,047
Messages
6,122,858
Members
449,096
Latest member
Erald

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