Running VBA with "custom variable"

HarryP96

New Member
Joined
Oct 20, 2020
Messages
11
Office Version
  1. 2010
Platform
  1. MacOS
Hi all,

I am extremely new to VBA so I apologize if this is a stupid question. However, I have created this code

VBA Code:
sub (format)
Sheets("T_maintained").Select
ActiveCell.Offset(0, 2).Activate
Dim B As Long
For B = 1 To 36
Fill
Next B

Sheets("Mastersheet").Select
ActiveCell.Offset(1, 0).Activate
ActiveCell.Offset(-649, 1).Activate
End Sub

Sub Fill()
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(18, 0)).Copy
Sheets("Mastersheet").Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(18, 0).Activate
Sheets("T_maintained").Select
ActiveCell.Offset(0, 1).Activate

End Sub

I would like to run this code for particular sheets as well as "T_maintained" but do not want to write the code out multiple times, replacing "T_maintained" for each replication of the code with another relevant work sheet. Every other component of the code would remain the same.

Is there a way I can convert the above code into a sort of function, where all I would need to do is type in function("name_of_appropriate_sheet") or something similar so that I do not need to repeat the code multiple times?

Thank you for your help.
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
There are some other things you can do to improve your code for efficiency, but I don't want to confuse you and only answer the question at hand.
This should work:

VBA Code:
Sub format()

SheetName = InputBox("Which Sheet?", "Choose a sheet")

Dim ws As Worksheet
foundsheet = 0
For Each ws In ThisWorkbook.Sheets
    If ws.Name = SheetName Then
        foundsheet = 1
        Exit For
    End If
Next
If foundsheet = 0 Then
    MsgBox ("No sheet by the name " & SheetName)
    Exit Sub
Else
    

    ws.Activate
    
    ActiveCell.Offset(0, 2).Activate
    
    Dim B As Long
    
    For B = 1 To 36
    
        Call Fill
    
    Next
    
    
    
    Sheets("Mastersheet").Select
    
    ActiveCell.Offset(1, 0).Activate
    
    ActiveCell.Offset(-649, 1).Activate
End If
End Sub



Sub Fill(MySheet As Worksheet)

Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(18, 0)).Copy

Sheets("Mastersheet").Select

ActiveCell.PasteSpecial Paste:=xlPasteValues

ActiveCell.Offset(18, 0).Activate

MySheet.Select

ActiveCell.Offset(0, 1).Activate


End Sub
 
Upvote 0
is your data always moving or located in the same 18 rows that you copy?
My main concern is that you use activecell a lot which means if your actively selected cell is incorrect you will get the incorrect results

You could rewrite the code to run from the activesheet and then run it from each sheet you need it to run on:

so run this from T_maintained and each sheet you need

VBA Code:
Sub Format2()

Dim CurrSh As Worksheet
Set CurrSh = ActiveSheet

ActiveCell.Offset(0, 2).Activate
Dim B As Long
For B = 1 To 36
        Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(18, 0)).Copy
        Sheets("Mastersheet").Select
        ActiveCell.PasteSpecial Paste:=xlPasteValues
        ActiveCell.Offset(18, 0).Activate
        CurrSh.Select
        ActiveCell.Offset(0, 1).Activate
Next B

Sheets("Mastersheet").Select
ActiveCell.Offset(1, 0).Activate
ActiveCell.Offset(-649, 1).Activate

End Sub
 
Upvote 0
Solution
is your data always moving or located in the same 18 rows that you copy?
My main concern is that you use activecell a lot which means if your actively selected cell is incorrect you will get the incorrect results

You could rewrite the code to run from the activesheet and then run it from each sheet you need it to run on:

so run this from T_maintained and each sheet you need

VBA Code:
Sub Format2()

Dim CurrSh As Worksheet
Set CurrSh = ActiveSheet

ActiveCell.Offset(0, 2).Activate
Dim B As Long
For B = 1 To 36
        Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(18, 0)).Copy
        Sheets("Mastersheet").Select
        ActiveCell.PasteSpecial Paste:=xlPasteValues
        ActiveCell.Offset(18, 0).Activate
        CurrSh.Select
        ActiveCell.Offset(0, 1).Activate
Next B

Sheets("Mastersheet").Select
ActiveCell.Offset(1, 0).Activate
ActiveCell.Offset(-649, 1).Activate

End Sub
Yes, the data is always in the same 18 rows. This worked perfectly, thank you so much.
 
Upvote 0
There are some other things you can do to improve your code for efficiency, but I don't want to confuse you and only answer the question at hand.
This should work:

VBA Code:
Sub format()

SheetName = InputBox("Which Sheet?", "Choose a sheet")

Dim ws As Worksheet
foundsheet = 0
For Each ws In ThisWorkbook.Sheets
    If ws.Name = SheetName Then
        foundsheet = 1
        Exit For
    End If
Next
If foundsheet = 0 Then
    MsgBox ("No sheet by the name " & SheetName)
    Exit Sub
Else
   

    ws.Activate
   
    ActiveCell.Offset(0, 2).Activate
   
    Dim B As Long
   
    For B = 1 To 36
   
        Call Fill
   
    Next
   
   
   
    Sheets("Mastersheet").Select
   
    ActiveCell.Offset(1, 0).Activate
   
    ActiveCell.Offset(-649, 1).Activate
End If
End Sub



Sub Fill(MySheet As Worksheet)

Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(18, 0)).Copy

Sheets("Mastersheet").Select

ActiveCell.PasteSpecial Paste:=xlPasteValues

ActiveCell.Offset(18, 0).Activate

MySheet.Select

ActiveCell.Offset(0, 1).Activate


End Sub
Thank you very much for this. I'm unfortunately well aware that my code is rather clunky, but this is literally my second day using VBA and I wanted to get this done quickly. Is there something in particular that I have done which I should avoid in the future? :)
 
Upvote 0
Welcome to the world of VBA Coding! I've written a lot of code like what you have above. A lot when I was new to it, and sometimes I write it now because quick and dirty running is better than efficiency down the line. For example if i'm doing a quick Adhoc, writing code in a minute that takes 5 minute to run is better than writing for 10 minutes for code that takes 30 seconds to run.

But here is something that might be helpful.

So as @cooper645 mentioned, the use of activecell is is a strain on the system. Since I don't exactly know where you're copying and pasting, I'm going to show some small samples here with copying 1000 cells from one sheet to another using a for loop.

If you want to run this code for yourself, make a new workbook with a Sheet1 and Sheet2. And put 1000 variables in column A rows 1 to 1000. I used the
Excel Formula:
=RAND()
function for this.

This first run copies the cell from the first sheet to the next, goes back to copy the next cell and then back to paste over and over. It took about 2.5 minutes to run.

VBA Code:
Sub firstrun()
starttime = Now()
For i = 1 To 1000
    Sheet1.Activate
    Sheet1.Cells(i, 1).Copy
    Sheet2.Activate
    Sheet2.Cells(i, 1).PasteSpecial
   
Next
ENDTIME = Now()
MsgBox (starttime & "--" & ENDTIME)
End Sub


Now this second version, I added the simple "application.screenupdating=false" and "application.screenupdating=true" code around the code, this stops the screen from flashing between each copy and paste, and it improved the run time to about 45 seconds

VBA Code:
Sub sECONDrun()
Application.ScreenUpdating = False

starttime = Now()
For i = 1 To 1000
    Sheet1.Activate
    Sheet1.Cells(i, 1).Copy
    Sheet2.Activate
    Sheet2.Cells(i, 2).PasteSpecial
   
Next
ENDTIME = Now()
Application.ScreenUpdating = True
MsgBox (starttime & "--" & ENDTIME)
End Sub

But this third time instead of looping through each cell I copied them all as a single range, and pasted them with the same line of code. I never had to activate a sheet, and the result was under a second

VBA Code:
Sub thirdrun()
Application.ScreenUpdating = False

starttime = Now()

Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1000, 1)).Copy Sheet2.Range(Sheet2.Cells(1, 3), Sheet2.Cells(1000, 3))

ENDTIME = Now()
Application.ScreenUpdating = True
MsgBox (starttime & "--" & ENDTIME)
End Sub
 
Upvote 0
Welcome to the world of VBA Coding! I've written a lot of code like what you have above. A lot when I was new to it, and sometimes I write it now because quick and dirty running is better than efficiency down the line. For example if i'm doing a quick Adhoc, writing code in a minute that takes 5 minute to run is better than writing for 10 minutes for code that takes 30 seconds to run.

But here is something that might be helpful.

So as @cooper645 mentioned, the use of activecell is is a strain on the system. Since I don't exactly know where you're copying and pasting, I'm going to show some small samples here with copying 1000 cells from one sheet to another using a for loop.

If you want to run this code for yourself, make a new workbook with a Sheet1 and Sheet2. And put 1000 variables in column A rows 1 to 1000. I used the
Excel Formula:
=RAND()
function for this.

This first run copies the cell from the first sheet to the next, goes back to copy the next cell and then back to paste over and over. It took about 2.5 minutes to run.

VBA Code:
Sub firstrun()
starttime = Now()
For i = 1 To 1000
    Sheet1.Activate
    Sheet1.Cells(i, 1).Copy
    Sheet2.Activate
    Sheet2.Cells(i, 1).PasteSpecial
  
Next
ENDTIME = Now()
MsgBox (starttime & "--" & ENDTIME)
End Sub


Now this second version, I added the simple "application.screenupdating=false" and "application.screenupdating=true" code around the code, this stops the screen from flashing between each copy and paste, and it improved the run time to about 45 seconds

VBA Code:
Sub sECONDrun()
Application.ScreenUpdating = False

starttime = Now()
For i = 1 To 1000
    Sheet1.Activate
    Sheet1.Cells(i, 1).Copy
    Sheet2.Activate
    Sheet2.Cells(i, 2).PasteSpecial
  
Next
ENDTIME = Now()
Application.ScreenUpdating = True
MsgBox (starttime & "--" & ENDTIME)
End Sub

But this third time instead of looping through each cell I copied them all as a single range, and pasted them with the same line of code. I never had to activate a sheet, and the result was under a second

VBA Code:
Sub thirdrun()
Application.ScreenUpdating = False

starttime = Now()

Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(1000, 1)).Copy Sheet2.Range(Sheet2.Cells(1, 3), Sheet2.Cells(1000, 3))

ENDTIME = Now()
Application.ScreenUpdating = True
MsgBox (starttime & "--" & ENDTIME)
End Sub
Thank you for this! I'll actually put in the command to stop screen updating, needless to say my code is running rather slowly at the moment!
 
Upvote 0
Where are the the ranges? C1:AL18

or something different

and where each time do they need to go on the master sheet?

donyou need to copy from every sheet except master sheet?

im sure we can help you to write a more efficient code
 
Upvote 0

Forum statistics

Threads
1,223,247
Messages
6,171,004
Members
452,374
Latest member
keccles

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