Shortening a procedure for VBA

[Keojey]

Hello,

I have a macro with VBA for this monthly chart that I make. I have a bunch of repeating lines of code that go for each day of the month but it ended up being too large of a procedure, so it doesn't allow me to execute it. I was wondering if I could get some help to possibly shorten this?

I have B1 as the first day of the month and H1 as the second day of the month, repeating all the way to a possible 31st day of the month. All this is doing is taking information from a chart that I have, which gets filled in, and moves it over to a data sheet. But this all gets transferred over to a different area if E3 is filled out with a different value, which is very critical.

If Sheets("Gen2").Range("E1") = Sheets("Gen2 Data").Range("B1") Then
  If Sheets("Gen2").Range("E3") = 1 Then Sheets("Gen2").Range("B3").Copy Destination:=Sheets("Gen2 Data").Range("B2")
  If Sheets("Gen2").Range("E3") = 2 Then Sheets("Gen2").Range("B3").Copy Destination:=Sheets("Gen2 Data").Range("E2")
  If Sheets("Gen2").Range("E3") = 1 Then Sheets("Gen2").Range("D3").Copy Destination:=Sheets("Gen2 Data").Range("C24")
  If Sheets("Gen2").Range("E3") = 2 Then Sheets("Gen2").Range("D3").Copy Destination:=Sheets("Gen2 Data").Range("C25")
  If Sheets("Gen2").Range("E3") = 1 Then Sheets("Gen2").Range("C3").Copy Destination:=Sheets("Gen2 Data").Range("C2:D2")
  If Sheets("Gen2").Range("E3") = 2 Then Sheets("Gen2").Range("C3").Copy Destination:=Sheets("Gen2 Data").Range("F2:G2")
  If Sheets("Gen2").Range("E3") = 1 Then Sheets("Gen2").Range("C7:E10,C12:E22,C24:E26,C28:E29").Copy Destination:=Sheets("Gen2 Data").Range("B4:D23")
  If Sheets("Gen2").Range("E3") = 2 Then Sheets("Gen2").Range("C7:E10,C12:E22,C24:E26,C28:E29").Copy Destination:=Sheets("Gen2 Data").Range("E4:G23")
  If Sheets("Gen2").Range("E3") = 1 Then Sheets("Gen2").Range("F8,F10,F14,F17,F20,F25").Copy Destination:=Sheets("Gen2 Data").Range("G33")
  If Sheets("Gen2").Range("E3") = 2 Then Sheets("Gen2").Range("F8,F10,F14,F17,F20,F25").Copy Destination:=Sheets("Gen2 Data").Range("H33")
End If
 
If Sheets("Gen2").Range("E1") = Sheets("Gen2 Data").Range("H1") Then
  If Sheets("Gen2").Range("E3") = 1 Then Sheets("Gen2").Range("B3").Copy Destination:=Sheets("Gen2 Data").Range("H2")
  If Sheets("Gen2").Range("E3") = 2 Then Sheets("Gen2").Range("B3").Copy Destination:=Sheets("Gen2 Data").Range("K2")
  If Sheets("Gen2").Range("E3") = 1 Then Sheets("Gen2").Range("D3").Copy Destination:=Sheets("Gen2 Data").Range("I24")
  If Sheets("Gen2").Range("E3") = 2 Then Sheets("Gen2").Range("D3").Copy Destination:=Sheets("Gen2 Data").Range("I25")
  If Sheets("Gen2").Range("E3") = 1 Then Sheets("Gen2").Range("C3").Copy Destination:=Sheets("Gen2 Data").Range("I2:J2")
  If Sheets("Gen2").Range("E3") = 2 Then Sheets("Gen2").Range("C3").Copy Destination:=Sheets("Gen2 Data").Range("L2:M2")
  If Sheets("Gen2").Range("E3") = 1 Then Sheets("Gen2").Range("C7:E10,C12:E22,C24:E26,C28:E29").Copy Destination:=Sheets("Gen2 Data").Range("H4:J23")
  If Sheets("Gen2").Range("E3") = 2 Then Sheets("Gen2").Range("C7:E10,C12:E22,C24:E26,C28:E29").Copy Destination:=Sheets("Gen2 Data").Range("K4:M23")
  If Sheets("Gen2").Range("E3") = 1 Then Sheets("Gen2").Range("F8,F10,F14,F17,F20,F25").Copy Destination:=Sheets("Gen2 Data").Range("I33")
  If Sheets("Gen2").Range("E3") = 2 Then Sheets("Gen2").Range("F8,F10,F14,F17,F20,F25").Copy Destination:=Sheets("Gen2 Data").Range("J33")
End If

Thank you!

 

[Keojey]

I have found a solution to this.

I just added a call function to split the procedure in half and have two procedures cycle through everything that needed to be done.