Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Information to being copied to new worksheet

Status
Not open for further replies.

wafs

Technical User
Jan 17, 2006
112
US
This macro runs and gives me my message Have A Nice Day, but it never puts it into the destination sheet. What am I over looking?


Sub Step1_PopulateInternetBuys()
'
' *****************************************************
' PopulateInternetBuys MACRO
'
' Description: This macro allows for the automatic entry
' data from the internet schedule into a list of all
' buys from that campaign.
'
' Macro created on 12/08/2005
'
'
' Written by Nick Britsky/Wendy Smith
' *****************************************************

' Declare Variables
Dim CellStart As Integer 'Row location of first sale
Dim CellEnd As Integer 'size of ad
Dim CellMaster As Integer 'Hold CellStart for Duration of Macro
Dim x As Integer 'For Statement Variable
Dim y As Integer 'For Statement Variable
Dim TestRange As String 'Test String
Dim TestRange2 As String 'Test String
Dim TestRange3 As String 'Test String
Dim TestRange4 As String 'Test String
Dim TestRange5 As String 'Test String
Dim i As String 'Counting Variable
Dim TotalBuys As String 'Count Total buys
Dim ReportLocation As String 'Location of output on report sheet
Dim Output(1 To 13) As String 'Output for individual buy
Dim n As String 'Counting Variable
Dim sh As String 'Source Sheet
Dim Destsh As String 'Destination Sheet
Dim CSVSh As String 'Sheet for CSV file
Dim m As String 'Counting Variable
Dim v As String 'Counting Variable
Dim z As Integer 'Another For Variable
Dim BuyDate(1 To 4) As String 'Month / Year of Buy / Holding Space
Dim TotalPapers As Integer ' Count Number of ads outputed
Dim AdCodeMaster(1 To 12) As String 'Stores the ad code: color / code, color / code, etc
Dim Dummy As String ' Test
Dim StartMonth As String ' Hold Month Name
Dim Month As Integer 'Count month
Dim Buyer As String 'Buyers Name

' Initialize Variables
CellStart = 4
CellMaster = CellStart
TotalBuys = 0
TotalPapers = 0
StartMonth = InputBox("Campagin Starts on which month? (three letters, example: Jan)", "StartMonth")
'Months = InputBox("How many months in campaign? (number of months, example: 6)", "Months")

Select Case StartMonth
Case "Jan"
BuyDate(4) = "01/"
Case "Feb"
BuyDate(4) = "02/"
Case "Mar"
BuyDate(4) = "03/"
Case "Apr"
BuyDate(4) = "04/"
Case "May"
BuyDate(4) = "05/"
Case "Jun"
BuyDate(4) = "06/"
Case "Jul"
BuyDate(4) = "07/"
Case "Aug"
BuyDate(4) = "08/"
Case "Sep"
BuyDate(4) = "09/"
Case "Oct"
BuyDate(4) = "10/"
Case "Nov"
BuyDate(4) = "11/"
Case "Dec"
BuyDate(4) = "12/"
End Select

sh = "Campaign "
Destsh = "-IOC"
CSVSh = "-CSV"

' Turn off Screen Updating
Application.ScreenUpdating = False

' Build ioc Sheet
For z = 1 To 50
'Call Function to Count lines


'Get Data from Rows
i = CellStart
TestRange = "K" + i
TestRange5 = "Z" + i
For x = CellStart To LastRow&
If Sheets(sh).Range(TestRange) > 0 Or Sheets(sh).Range(TestRange5) > 0 Then
TestRange2 = "K" + i
TestRange4 = TestRange2
Sheets(sh).Range(TestRange2).Select
v = 1
For y = 1 To 39
n = CellStart
If Selection <> 0 Then
TotalBuys = TotalBuys + 1

'Prep Title
'Output(1) = "B" + n
'Output() = Sheets(sh).Range(Output(1)).Value

' Prep Client
Output(10) = Sheets(sh).Range("M1").Value

'Prep Product
Output(9) = Sheets(sh).Range("M2").Value

'Prep Estimate
Output(2) = Sheets(sh).Range("M3").Value
'Buyers Name
Output(12) = Sheets(sh).Range("M6").Value

'Prep Month

'i = Months
'TestRange = Months + i
'Do
'i = i + 1
' TestRange = Months + i
'Loop While Not IsEmpty(Sheets(sh).Range(TestRange))
'i = i + 1


'Prep Start Month
BuyDate(3) = "/06"
If v < 6 And StartMonth = "Jul" Then
BuyDate(1) = "12/"
BuyDate(3) = "/04"
Else
BuyDate(1) = BuyDate(4)
End If
v = v + 1
Output(7) = BuyDate(1) + BuyDate(3)

'Prep Pub
Output(3) = "A" + n
Output(4) = Sheets(sh).Range(Output(3)).Value


'Prep Cost
'Output(5) = "J" + i
'Output(6) = Sheets(sh).Range(Output(5)).Value

'Prep Ad Code

'Output(8) = FindAdCode(AdCodeMaster, sh, TestRange4)

' Output Info to -IOC sheet
m = TotalBuys + 1
ReportLocation = "B" + m
If selectin = 1 Then
Sheets(Destsh).Range(ReportLocation) = Output(13)
ReportLocation = "K" + m
Sheets(Destsh).Range(ReportLocation) = 1
Else
End If
ReportLocation = "F" + m 'Pub
Sheets(Destsh).Range(ReportLocation) = Output(4)
ReportLocation = "G" + m 'Date
Sheets(Destsh).Range(ReportLocation) = Output(7)
ReportLocation = "I" + m 'Cost
Sheets(Destsh).Range(ReportLocation) = Output(6)
'ReportLocation = "J" + m 'Ad Code
'Sheets(Destsh).Range(ReportLocation) = Output(8)
ReportLocation = "C" + m 'Client
Sheets(Destsh).Range(ReportLocation) = Output(10)
ReportLocation = "E" + m 'Estimate
Sheets(Destsh).Range(ReportLocation) = Output(2)
ReportLocation = "K" + m 'Buyer
Sheets(Destsh).Range(ReportLocation) = Output(12)
ReportLocation = "D" + m 'Product
Sheets(Destsh).Range(ReportLocation) = Output(9)
Else
End If
Selection.Offset(o, 1).Select
TestRange4 = Selection.Address
v = v + 1
Next
Else
End If
i = i + 1
TestRange = "T" + i
TestRange5 = "BK" + i
Next
CellStart = LastRow& + 2
TotalBuys = TotalBuys + 1
TestString3 = Output(2)
Next

'Turn on Screen Updating
Application.ScreenUpdating = True
MsgBox "Done! Have a Super Day."
End Sub
Function LastCell(ws As Worksheet) As Range
Dim LastRow&, LastCol%

' Error-handling is here in case there is not any
' data in the worksheet

On Error Resume Next

With ws

' Find the last real row

LastRow& = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row

' Find the last real column

LastCol% = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column

End With

' Finally, initialize a Range object variable for
' the last populated row.

Set LastCell = ws.Cells(LastRow&, LastCol%)

End Function
 


Hi,

Still at it, huh?

Not enought info. How EXACTLY do you respond to the marco?

Skip,

[glasses] [red]Be Advised![/red] For those this winter, caught in Arctic-like calamity, be consoled...
Many are cold, but few are frozen![tongue]
 
At least I don't get any errors now.

What do you mean by respond to marco?

The macro ask for the month, I put in Jul and it runs except the info does not move over into another excel sheet.

 


Your macro never assigns a value to LastRow&

Your macro never uses function LastCell

It probably belongs here...
Code:
...
' Build ioc Sheet
        For z = 1 To 50
           'Call Function to Count lines
[b][red]==>>[/red][/b]           
                       
'Get Data from Rows

...


Skip,

[glasses] [red]Be Advised![/red] For those this winter, caught in Arctic-like calamity, be consoled...
Many are cold, but few are frozen![tongue]
 
OK. I will give it a try. I just knew that I needed to get the macro to stop at the end of the spreadsheet.
 
I moved the lastcell code and the macro still does the same thing. Runs through and pops up my Don! Have a nice day message.
 


Try stepping thru it or using the Breakpoint toggle.

While in DEBUG, use the Watch Window to view key variable values to see if what you expect is what you got.

Skip,

[glasses] [red]Be Advised![/red] For those this winter, caught in Arctic-like calamity, be consoled...
Many are cold, but few are frozen![tongue]
 
Thanks for the tip, lets see what I can find.
 


In particular, I'd be looking at the LIMITS for the 3 for...next loops.

Skip,

[glasses] [red]Be Advised![/red] For those this winter, caught in Arctic-like calamity, be consoled...
Many are cold, but few are frozen![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top