VBA Loop on Overly Coded Macro

[Weber]

The Form that was created made the copy and paste macro much larger than I wanted to be. I am pulling data from a data set and completing a form. Images Attached. I have a code completing the form and saving it with a unique name but now Im not sure how to create a loop to have it move down the rows. Any assistance would be greatly appreciated.


Sub AutoContests

Range("A2").Select Selection.Copy
Sheets("Promo Order Form").Select
Range("$C$13:$D$13").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Promo Order Form").Select
Range("$C$18:$D$18").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("C2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Promo Order Form").Select
Range("$C$14:$D$14").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Promo Order Form").Select
Range("$C$16:$D$16").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Promo Order Form").Select
Range("$D$33").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("G2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Promo Order Form").Select
Range("$C$33").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("I2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Promo Order Form").Select
Range("$C$12:$D$12").Select
ActiveSheet.Paste
Sheets("Data Entry").Select
Range("J2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Promo Order Form").Select
Range("$B$33").Select
ActiveSheet.Paste
Application.CutCopyMode = False


End Sub



Sub SaveReport()
Dim fileName As String

fileName = Range("A2").Value & " " & Range("G2").Value & " " & Range("F2").Value

ActiveWorkbook.SaveAs fileName:="I:\Marketing\Trade Team\Contests" & fileName, FileFormat:=xlOpenXMLStrictWorkbook
End Sub

Again thank you for your help.

[SamT]

If you are going to learn to use VBA Code, the first step is to record Macros and clean them up. Your self.

Example1:

Range("A2").Select Selection.Copy
Sheets("Promo Order Form").Select
Range("$C$13:$D$13").Select
ActiveSheet.Paste
Cleans up to

Range("A2").Copy Sheets("Promo Order Form")Range("$C$13:$D$13")
Application.CutCopyMode = False


Example2:

Sheets("Data Entry").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Promo Order Form").Select
Range("$C$16:$D$16").Select
ActiveSheet.Paste
Cleans up to:

'Note Line Continuation Marker " _"
Sheets("Data Entry").Range("D2").Copy _
Sheets("Promo Order Form")Range("$C$16:$D$16")
Application.CutCopyMode = False

[Weber]

Ill get this cleaned up. First day using macros/vbas just off googling things. Thank you for showing me.

[Weber]

On the first


Range("A2").Copy Sheets("Promo Order Form")Range("$C$13:$D$13")
Application.CutCopyMode = False

Its giving me a compile error expected end of statement on the second range

Why would this happen?

[SamT]

Missing the Dot after Sheets("Promo Order Form")

See if this fixes it. The Keyword "Destination:=" is optional

Range("A2").Copy Destination:=Sheets("Promo Order Form").Range("$C$13:$D$13")

[Weber]

SamT

This fixed it. Again thank you for the help. I will get this all cleaned up and will keep studying up on macro cleaning.

[Weber]

OK so this has been cleaned to


Sub AutoContests()


Sheets("Data Entry").Range("A2").Copy _
Sheets("Promo Order Form").Range("$C$13:$D$13")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("B2").Copy _
Sheets("Promo Order Form").Range("$C$18:$D$18")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("C2").Copy _
Sheets("Promo Order Form").Range("$C$14:$D$14")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("D2").Copy _
Sheets("Promo Order Form").Range("$C$16:$D$16")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("F2").Copy _
Sheets("Promo Order Form").Range("$D$33")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("G2").Copy _
Sheets("Promo Order Form").Range("$C$33")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("I2").Copy _
Sheets("Promo Order Form").Range("$C$12:$D$12")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("J2").Copy _
Sheets("Promo Order Form").Range("$B$33")
Application.CutCopyMode = False


End Sub


And



Sub SaveReport()
Dim fileName As String

fileName = Range("A2").Value & " " & Range("G2").Value & " " & Range("F2").Value

ActiveWorkbook.SaveAs fileName:="I:\Marketing\ASWO_Marketing\Trade Team\Contests\" & fileName, FileFormat:=xlOpenXMLStrictWorkbook
End Sub



would I just use an offet(1,0) in a loop to pull and save the correct information? Do the $ override the offset?

[Paul_Hossler]

Possible next step




Option Explicit
Sub AutoContests()
Dim wsPromo As Worksheet

Set wsPromo = Sheets("Promo Order Form")

With Sheets("Data Entry")
.Range("A2").Copy wsPromo.Range("$C$13:$D$13")
.Range("B2").Copy wsPromo.Range("$C$18:$D$18")
.Range("C2").Copy wsPromo.Range("$C$14:$D$14")
.Range("D2").Copy wsPromo.Range("$C$16:$D$16")
.Range("F2").Copy wsPromo.Range("$D$33")
.Range("G2").Copy wsPromo.Range("$C$33")
.Range("I2").Copy wsPromo.Range("$C$12:$D$12")
.Range("J2").Copy wsPromo.Range("$B$33")
End With

Application.CutCopyMode = False
End Sub




would I just use an offet(1,0) in a loop to pull and save the correct information? Do the $ override the offset?

1. Since there does not seem to be any pattern to the destination cells, using .Offset in a loop would probably not gain anything except more complexity

2. The $ has to do with Absolute and Relative Addresses (check help for details)

[Weber]

Paul,

Thanks for your response. The Destination cells will stay the same as they are the form locations. I just need to change the copy location in the loop. I know this is really confusing. Im really new at this and really appreciate the help.

Im aware that $ references absolute values, I was unaware of having that there would make it so if it was offset to (1,0) it would just change the copy location not the destination location.

Thank you for your help.

[SamT]

Absolute Cell Addresses do not affect .Offset

Since all destinations cannot be put in a loop, don't loop thru the sources.

[Weber]

Do you see any way to do this?

What if I added delete row 2 at the end of the first sub? I store the data in another location anyway.

[SamT]

Do you see any way to do this?Do what?


What if I added delete row 2 at the end of the first sub? I store the data in another location anyway.Hunh!? What!?

[Weber]

To take the data from "Data Entry" fill out the form in "Promo Order Form" Save the form and then start on the next row in "Data Entry". I have to fill out around 1000 forms and im just trying to automate it.

[Weber]

Ok heres my Idea.


Sub AutoContests()


Sheets("Data Entry").Range("A2").Copy _
Sheets("Promo Order Form").Range("$C$13:$D$13")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("B2").Copy _
Sheets("Promo Order Form").Range("$C$18:$D$18")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("C2").Copy _
Sheets("Promo Order Form").Range("$C$14:$D$14")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("D2").Copy _
Sheets("Promo Order Form").Range("$C$16:$D$16")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("F2").Copy _
Sheets("Promo Order Form").Range("$D$33")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("G2").Copy _
Sheets("Promo Order Form").Range("$C$33")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("I2").Copy _
Sheets("Promo Order Form").Range("$C$12:$D$12")
Application.CutCopyMode = False
'Line Break
Sheets("Data Entry").Range("J2").Copy _
Sheets("Promo Order Form").Range("$B$33")
Application.CutCopyMode = False

Dim fileName As String

fileName = Range("A2").Value & " " & Range("G2").Value & " " & Range("F2").Value

ActiveWorkbook.SaveAs fileName:="I:\Marketing\ASWO_Marketing\Trade Team\Contests\" & fileName, FileFormat:=xlOpenXMLStrictWorkbook

Sheets("Data Entry").Rows(2).Delete


End Sub


How would I loop this until there is no data in row 2? I pull the information and paste it in form a google sheet anyway. I also probably need to change

FileFormat:=xlOpenXMLStrictWorkbook

to a format that wont ask me about not saving the Macros.

Let me know what yall think.

[Paul_Hossler]

1. Looping rows 2 - N on DataEntry is easy

2. You put data into Promo Order Form into rows 13, 18, 14, 16, 33, and 12

3. I'm guessing that your unstated objective is to use the Data Entry list to fill out a template Promo Order Form worksheet and then save that worksheet as a separate file with a certain name



Option Explicit

Sub AutoContent()
Dim wsPromo As Worksheet
Dim sFileName As String
Dim i As Long
Dim wbMaster As Workbook, wbPromo As Workbook

Set wbMaster = ThisWorkbook
Set wsPromo = Sheets("Promo Order Form")

Application.ScreenUpdating = False

With Sheets("Data Entry")
For i = 2 To .Cells(1, 1).CurrentRegion.Rows.Count
.Cells(i, 1).Copy wsPromo.Range("$C$13:$D$13")
.Cells(i, 2).Copy wsPromo.Range("$C$18:$D$18")
.Cells(i, 3).Copy wsPromo.Range("$C$14:$D$14")
.Cells(i, 4).Copy wsPromo.Range("$C$16:$D$16")
.Cells(i, 6).Copy wsPromo.Range("$D$33")
.Cells(i, 7).Copy wsPromo.Range("$C$33")
.Cells(i, 9).Copy wsPromo.Range("$C$12:$D$12")
.Cells(i, 10).Copy wsPromo.Range("$B$33")

Application.CutCopyMode = False

sFileName = .Cells(i, 1).Value & " " & .Cells(i, 7).Value & " " & .Cells(i, 6).Value

wsPromo.Copy

Set wbPromo = ActiveWorkbook
wbPromo.SaveAs fileName:=sFileName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

ActiveWindow.Close
Next i
End With

Application.ScreenUpdating = True

End Sub