VBA Copy / Paste across multiple worksheets (If Statement)

[azimm29]

Hey guys,

I have created some VBA code which I think is very inefficient for the task that it completes.

The purpose: Every time the "Budtender List" is updated, the user can click an image and run a macro. The macro is designed to copy the list (currently defined as "A1:a100", which is not dynamic) to the End of Month Worksheet and each worksheet that is greater than or equal to today. Each tab is named "##", to represent a day of the month. For today, 5/6/2016, the macro pastes the list into tabs 6,7,...,30,31,EOM.

The code is pasting into tables, and it would be awesome if the length of the table was defined by the length of the Budtender list. Also, if the code would copy down the formulas in rows C, E, & F to match the length of the Budtender List, that would be awesome!!

If anyone has improvements to this code, I would be greatly appreciative.

The code is below:

Sub Budtender_List()


Application.OnKey "^r", "Budtender_List"


Dim ws1 As Worksheet
Dim ws2 As Worksheet
...
Dim ws31 As Worksheet
Dim BL As Worksheet
Dim EOM As Worksheet




Set ws1 = Sheets("1")
Set ws2 = Sheets("2")
...
Set ws31 = Sheets("31")
Set BL = Sheets("Budtender List")
Set EOM = Sheets("End of Month")




BL.Range("A1:A100").Copy _
EOM.Range("A1:a100")
If (Date <= DateSerial(Year(Now), Month(Now), 1)) Then
BL.Range("A1:A100").Copy _
ws1.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 2)) Then
BL.Range("A1:A100").Copy _
ws2.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 3)) Then
BL.Range("A1:A100").Copy _
ws3.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 4)) Then
BL.Range("A1:A100").Copy _
ws4.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 5)) Then
BL.Range("A1:A100").Copy _
ws5.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 6)) Then
BL.Range("A1:A100").Copy _
ws6.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 7)) Then
BL.Range("A1:A100").Copy _
ws7.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 8)) Then
BL.Range("A1:A100").Copy _
ws8.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 9)) Then
BL.Range("A1:A100").Copy _
ws9.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 10)) Then
BL.Range("A1:A100").Copy _
ws10.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 11)) Then
BL.Range("A1:A100").Copy _
ws11.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 12)) Then
BL.Range("A1:A100").Copy _
ws12.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 13)) Then
BL.Range("A1:A100").Copy _
ws13.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 14)) Then
BL.Range("A1:A100").Copy _
ws14.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 15)) Then
BL.Range("A1:A100").Copy _
ws15.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 16)) Then
BL.Range("A1:A100").Copy _
ws16.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 17)) Then
BL.Range("A1:A100").Copy _
ws17.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 18)) Then
BL.Range("A1:A100").Copy _
ws18.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 19)) Then
BL.Range("A1:A100").Copy _
ws19.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 20)) Then
BL.Range("A1:A100").Copy _
ws20.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 21)) Then
BL.Range("A1:A100").Copy _
ws21.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 22)) Then
BL.Range("A1:A100").Copy _
ws22.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 23)) Then
BL.Range("A1:A100").Copy _
ws23.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 24)) Then
BL.Range("A1:A100").Copy _
ws24.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 25)) Then
BL.Range("A1:A100").Copy _
ws25.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 26)) Then
BL.Range("A1:A100").Copy _
ws26.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 27)) Then
BL.Range("A1:A100").Copy _
ws27.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 28)) Then
BL.Range("A1:A100").Copy _
ws28.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 29)) Then
BL.Range("A1:A100").Copy _
ws29.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 30)) Then
BL.Range("A1:A100").Copy _
ws30.Range("a1:a100")
End If
If (Date <= DateSerial(Year(Now), Month(Now), 31)) Then
BL.Range("A1:A100").Copy _
ws31.Range("a1:a100")
End If

End Sub

Thank you for your help,
-Azimm

 

[JLGWhiz]

this could probably be done a lot better, but try is and see if it gets the lists copied to the correct sheets.

Sub Budtender_List()
 Application.OnKey "^r", "Budtender_List"
 Dim BL As Worksheet
 Dim EOM As Worksheet
 Set BL = Sheets("Budtender List")
 Set EOM = Sheets("End of Month")
 BL.Range("A1:A100").Copy _
 EOM.Range("A1:a100")
    For i = Day(Date) - 1 To 31
        BL.Range("A1:A100").Copy Sheets(CStr(i).Range("A1")
    Next
 End Sub

 

[azimm29]

The run-time on this is a lot faster than the original! I really appreciate your help JLGWhiz..

It accomplishes the task, but it pastes the budtender list into the day before. E.g. today is 5/10/2016, and the macro adds to sheet 9-31 and End of Month. Not really a problem because the End of month sheet aggregates using Sumif and having extra names is really not a problem! Also, if someone leaves, losing their name on the 9th is not a problem because we don't care about their performance if they leave.

One question remains: How do I make each of the tables the length of the budtender list? That would make this totally awesome!

Thanks for the help so far! I already appreciate these forums after the first post

-Azimm29

 

[JLGWhiz]

See if this is better

Sub Budtender_List()
 Application.OnKey "^r", "Budtender_List"
 Dim BL As Worksheet
 Dim EOM As Worksheet
 Set BL = Sheets("Budtender List")
 Set EOM = Sheets("End of Month")
 BL.Range("A1", BL.Cells(Rows.Count, 1).End(xlUp)).Copy _
 EOM.Range("A1")
    For i = Day(Date) To 31
        BL.Range("A1", BL.Cells(Rows.Count, 1).End(xlUp)).Copy Sheets(CStr(i)).Range("A1")
    Next
 End Sub

 

[azimm29]

JLGWhiz,

You are a stud! That fix where you used

For i=Day(Date) to 31

Made it so the budtender list was updated for the appropriate date range. I don't understand the difference, but it works great!

I appreciate your help!
-Azimm29

 

[JLGWhiz]

JLGWhiz,

You are a stud! That fix where you used

For i=Day(Date) to 31

Made it so the budtender list was updated for the appropriate date range. I don't understand the difference, but it works great!

I appreciate your help!
-Azimm29

The function 'Day(Date) returns a single number from 1 To 31 for the day of the month based on the date in parentheses, in this case the current date represented by vba constant 'Date'. When I had the minus 1 in, it subtracted one from the number generated by the function making it equivalent to yesterday's day of the month day. Now it gives you today's day of the month day.
Regards, JLG