PDA

View Full Version : Solved: Cut and Paste Problem



Steve538
08-06-2010, 02:26 PM
I'm having a problem doing cut and past. I'm downloading stock quotes from yahoo, and some of the companies have an comma in their company name. When I do the TextToColumns it puts the company name into 2 columns instead of just 1. So I wrote some code the check for this condition and correct it. (I don't care about the second part if the name. I't usually an Inc and I can just throw it away.


i = 9

While Cells(i, "A") <> ""
If Cells(i, "O") <> "" Then
Range(Cells(i, "J"), Cells(i, "O")).Cut
DataSheet.Paste (Cells(i, "I"))
End If

i = i + 1
Wend

It works alright on a machine running Excel 2003, but I'm running it on one that has Excel 2000. When it gets to the DataSheet.Paste instruction it cause a major fault and closes Excel. I'm a novice, and I'm sure I'm doing something wrong, but I know not where.

rbrhodes
08-06-2010, 02:57 PM
Hi,

Your paste line cannot work. Presuming datasheet is defined elsewhere, both Cut and Copy have an optional destination argument:



Range(Cells(i, "J"), Cells(i, "O")).Cut datasheet.Cells(i, "I")

Steve538
08-06-2010, 03:38 PM
I'm still doing something wrong. When I paste your line of code in and coment out the outher 2 then run I get

method "cut" of object "range" failed

I then put an exitsub after my original cut command and ran it. When it hit the first occurance it exited like I wanted. The spreedsheet showed the cells correcty selected, and if I did a manual paste it did it correctly. I'm
sure I'm missing something in the setup of the operation.

I think I have the DataSheet set up correctly

Set DataSheet = ActiveSheet

GTO
08-07-2010, 01:01 AM
Greetings Steve,

I did not have a problem with your original code, modified only for clarity (mine):

Option Explicit

Sub exa()
Dim DataSheet As Worksheet
Dim i As Long

Set DataSheet = ActiveSheet

i = 9

With DataSheet
While .Cells(i, "A") <> ""
If Cells(i, "O") <> "" Then
.Range(.Cells(i, "J"), .Cells(i, "O")).Cut
.Paste (Cells(i, "I"))
End If
i = i + 1
Wend
End With
End Sub


Or with .Cut to include Destination:

Sub exa2()
Dim DataSheet As Worksheet
Dim i As Long

Set DataSheet = ActiveSheet

i = 9

With DataSheet
While .Cells(i, "A") <> ""
If Cells(i, "O") <> "" Then
.Range(.Cells(i, "J"), .Cells(i, "O")).Cut .Cells(i, "I")
End If
i = i + 1
Wend
End With
End Sub


Unless I'm missing something (quite possible), maybe just delete the cell though?

Sub exa3()
Dim DataSheet As Worksheet
Dim i As Long

Set DataSheet = ActiveSheet

i = 9

With DataSheet
While .Cells(i, "A") <> ""
If Cells(i, "O") <> "" Then
.Cells(i, "I").Delete Shift:=xlToLeft
End If
i = i + 1
Wend
End With
End Sub


If still not working, could you show the procedure in its entirety (along with any procedures called therein)? I am currently on a sickly machine with XP and Excel2000 - thus am confident it is not a 2000 issue.

Hope that helps,

Mark

Steve538
08-07-2010, 07:27 AM
I tried your cut/past macro but no luck. I get the error
method "cut" of object "range" failed

Plus when I close debug I'm unable to manually slect a columb.
I've tried the delete, but I have data to the right of that area.

Sub GetData()
' This is a modification of a well known stock data dowmload macro
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i, j, k, l As Integer
Dim f As Boolean
Dim s As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Set DataSheet = ActiveSheet

Range("H7").CurrentRegion.ClearContents


' This puts the Dow and NASDAQ quotes on rows 7 and 8
' Eventually I'll remove this since I alway start my lists with them

qurl = "http://download.finance.yahoo.com/d/quotes.csv?s=^DJI+^IXIC&f=nl1c6phgv (http://download.finance.yahoo.com/d/quotes.csv?s=^DJI+^IXIC&f=nl1c6phgv)"

Range("A7") = "^DJI"
Range("A8") = "^IXIC"

With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("H7"))
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With


' Now I start grabing quotes 90 at a time (I think Yahoo only allows 100 at a call
' so I'll stay below for safety).

i = 9
j = i
k = 0
f = False

qurl = "http://download.finance.yahoo.com/d/quotes.csv?s (http://download.finance.yahoo.com/d/quotes.csv?s)="


While Cells(i, 1) <> ""

If f = True Then qurl = qurl + "+"
f = True
qurl = qurl + Cells(i, 1)
i = i + 1
k = k + 1

If k = 90 Then
qurl = qurl + "&f=nl1c6phgv"

With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range(Cells(j, "H"), Cells(j, "H")))
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With

j = i
k = 0
f = False

qurl = "http://download.finance.yahoo.com/d/quotes.csv?s (http://download.finance.yahoo.com/d/quotes.csv?s)="
End If

Wend

' This take care of any partial number

If f = True Then

qurl = qurl + "&f=nl1c6phgv"

With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range(Cells(j, "H"), Cells(j, "H")))
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
End If

' This parsecs the strings recieved

Range("H7").CurrentRegion.TextToColumns Destination:=Range("H7"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False

' Everything works up to here

i = 9

While Cells(i, "A") <> ""
If Cells(i, "O") <> "" Then
Range(Cells(i, "J"), Cells(i, "O")).Cut
DataSheet.Paste (Cells(i, "I")) ' If I Rem out this line macro works but does not correct fo extra commas
End If

i = i + 1
Wend

' Clean up

Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Columns("H:H").ColumnWidth = 25.43
Columns("O:O").ColumnWidth = 1
Columns("I:I").NumberFormat = "###0.00"
Columns("J:L").NumberFormat = "###0.00"
Columns("K:L").NumberFormat = "###0.00"
Columns("L:L").NumberFormat = "###0.00"
Columns("M:M").NumberFormat = "###0.00"
Columns("N:N").NumberFormat = "#,##0"

Range("A1").Select
End Sub

The macro looks for a stock in columb A starting at row 9
and continues untill it hit any empty cell

UQM
UPI
WAL
WH
YMI
ZAGG

rbrhodes
08-07-2010, 02:57 PM
Hi,

Tried it in Excel 97 to 2007. Worked fine.

I then cleaned up the code and qualified everything. See if it works for you now.



Option Explicit
Sub GetData()
' This is a modification of a well known stock data dowmload macro
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim s As String
Dim f As Boolean
Dim qurl As String
Dim DataSheet As Worksheet
Dim QuerySheet As Worksheet
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
Set DataSheet = ActiveSheet
With DataSheet
.Range("H7").CurrentRegion.ClearContents
' This puts the Dow and NASDAQ quotes on rows 7 and 8
' Eventually I'll remove this since I alway start my lists with them
qurl = "http://download.finance.yahoo.com/d/quotes.csv?s=^DJI+^IXIC&f=nl1c6phgv"
.Range("A7") = "^DJI"
.Range("A8") = "^IXIC"
With .QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("H7"))
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With

' Now I start grabing quotes 90 at a time (I think Yahoo only allows 100 at a call
' so I'll stay below for safety).
i = 9
j = i
k = 0
f = False
qurl = "http://download.finance.yahoo.com/d/quotes.csv?s="

While .Cells(i, 1) <> ""
If f = True Then qurl = qurl + "+"
f = True
qurl = qurl + Cells(i, 1)
i = i + 1
k = k + 1
If k = 90 Then
qurl = qurl + "&f=nl1c6phgv"
With .QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range(Cells(j, "H"), Cells(j, "H")))
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
j = i
k = 0
f = False
qurl = "http://download.finance.yahoo.com/d/quotes.csv?s="
End If
Wend
' This take care of any partial number
If f = True Then
qurl = qurl + "&f=nl1c6phgv"
With .QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range(Cells(j, "H"), Cells(j, "H")))
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
End If
' This parses the strings recieved
.Range("H7").CurrentRegion.TextToColumns Destination:=.Range("H7"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False
' Everything works up to here
i = 9
While .Cells(i, "A") <> ""
If .Cells(i, "O") <> "" Then
.Range(Cells(i, "J"), Cells(i, "O")).Cut
.Paste (.Cells(i, "I")) ' If I Rem out this line macro works but does not correct fo extra commas
End If
i = i + 1
Wend

.Columns("H:H").ColumnWidth = 25.43
.Columns("O:O").ColumnWidth = 1
.Columns("I:M").NumberFormat = "###0.00"
.Columns("N:N").NumberFormat = "#,##0"
.Range("A1").Select

End With

' Clean up
With Application
.Calculation = xlCalculationAutomatic
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

Steve538
08-07-2010, 03:43 PM
Thank for cleaning up my code. I'm a novice so I write it sloppy then clean it up after I get it to work. I put your code into a new module and renamed it GetData1, reasigned the button to GetData1. When I ran it I got the dreaded Windows Needs To Close

send error report

When I sent the report Microsoft said that they don't support Excel 2000, and I should upgrade.

Like mine if I comment out the paste instruction in yours and run its works with the exception of the offsetted cells.

I'm running on a laptop with XP Professional using Excel 2000 SP3 I haven't had any problems running any code.

Steve538
08-07-2010, 05:46 PM
I haven't solved the problem, but I found a workaround.


While .Cells(i, "A") <> ""
If .Cells(i, "O") <> "" Then
.Range(Cells(i, "J"), Cells(i, "O")).Cut
.Paste (.Cells(i, "I"))
End If
i = i + 1
Wend



While .Cells(i, "A") <> ""
If .Cells(i, "O") <> "" Then
.Range(Cells(i, "J"), Cells(i, "O")).Copy
.Paste (.Cells(i, "I"))
.Cells(i, "O") = ""
End If
i = i + 1
Wend



I would still like to know why the cut/paste doesn't work, but this will do for now.

Thanks to everyone that tried to help me. Much appreciated.

Steve