Help with script: STARTING A NEW SUB.. (within sub?)

N

Nastech

hi, I have a script trying to add, have a prolem with:
- inserting as a sub, my incorrect labelling?,
(problem: using button for item below the XXX's area, comes up with
error for my trying to insert a sub, to a sub? problem, e.g.: "M" button
for moving script does not work in "test" sheet, because script incorrectly
entered).

- script is from another workbook, trying to incorporate into main sheet.
(have not had a chance to try yet, may / may not work for max 190 lines
per internet? request). thanks.

new script starts after XXXX's


Option Explicit
Private Sub CommandButton1_Click()
Dim testCellAddress As String '"DN6" from B1
Dim singleColumnID As String 'B2
Dim groupOneColumnID As String 'B3
Dim groupTwoColumnID As String 'B4
Dim groupThreeSourceID As String 'B5
Dim groupThreeDestinationID As String 'B6
Dim DateCellAddress As String 'date

'address must remain stable. get active sheet values or reference
different sheet in similar fashion:
'testCellAddress=Worksheets("AnotherSheetName").Range("B1")

testCellAddress = Range("B1") '.Value is implied
singleColumnID = Range("B2")
groupOneColumnID = Range("B3")
groupTwoColumnID = Range("B4")
groupThreeSourceID = Range("B5")
groupThreeDestinationID = Range("B6")
DateCellAddress = Range("D3") 'date


' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Work area (between X's), AM
SURE DOES NOT WORK YET

If Range(testCellAddress).Value = "X" Then 'PROBLEM: unexpected sub,
generally correct as below
Private Sub Worksheet_GetData(ByVal Target As Excel.Range) 'PROBLEM:
tried ~7 variations

Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer
Dim Column1ID As String 'my addition, variables (url..?s=) below
Dim Column2ID As String 'my addition, DESTINATION
Dim topRowID As String 'my addition

Column1ID = Range("E4") 'has:
=SUBSTITUTE(SUBSTITUTE(CELL("address",$AU4),"$",""),ROW(),"")
Column2ID = Range("E5") 'has:
=SUBSTITUTE(SUBSTITUTE(CELL("address",$EE4),"$",""),ROW(),"")
topRowID = Range("C6") 'top of grid, should I modify for rows in grid
to a range?
'C4 ALTERNATIVE / USE cells column AU that do not have ".", C6 has:
=ROW($A$139)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Set DataSheet = ActiveSheet

' ---------- my addition, if correct idea? need to mix with next section
With Target
If .Count > 1 Then Exit Sub
If Target.Row < topRowID Then Exit Sub
' If Me.Cells(.Row, "A").Value = "." Then Exit Sub 'need to change
to indirect with Column1ID
If Me.Cells(.Row, Column1ID).Value = "." Then Exit Sub 'will see if
this is correct

' ---------- end my addition, this old version works in separate file:

'i = 4 ' PROBLEM 1: need help with integer references, per above,
start row is not row 4..
'qurl = "http://finance.yahoo.com/d/quotes.csv?s=" + Cells(i, 1)
'i = i + 1
' While Cells(i, 1) <> ""
'While Cells(i, 1) <> "." 'cells not = "." in column AU MY ADDITION
may not be correct
' qurl = qurl + "+" + Cells(i, 1)
' i = i + 1
'Wend

'qurl = qurl + "&f=" + Range("E2") 'find format tags in cell
'Range("E3") = qurl 'place string in cell

' ---------- new version, haven't tested yet, cannot use button for item
below, for error here.
' Problem?: max lines allowed per download is 190 (200) not sure if
working. can designate start and stop rows..

lr = Cells(2, Column1ID).End(xlDown).Row
For i = 1 To lr
'MsgBox Cells(i, "a")
qurl = "http://website?s=" + Cells(i, 1)
Next i

qurl = qurl + "&f=" + Range("E2") 'find format tags in cell
Range("E3") = qurl 'place string in cell

' ---------- end new, following orig: (except for Column2ID was: "C4")

QueryQuote: 'PROBLEM 2: C4, need use of Column1/2ID and.. ?
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl,
Destination:=DataSheet.Range(Column2ID))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
'PROBLEM 2: C4
Range("C4").CurrentRegion.TextToColumns
Destination:=Range(Column2ID), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False

' Application.Calculation = xlCalculationAutomatic 'leave off
Application.Calculate 'I ADDED, for use in my sheet
Application.DisplayAlerts = True
' Columns("C:C").ColumnWidth = 5.14
Range("A1").Select 'place cursor in cell

End Sub
End If

' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX


If Range(testCellAddress).Value = "M" Then 'MOVE DATA
'1 col: copy Paste-Values to left 1 col
Columns(singleColumnID).Select
Selection.Copy
Range(singleColumnID).Offset(0, -1).Select '1 column to left
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

'22 col: (main, 21 col back up), COPY: Paste-Values to right 1 col
Columns(groupOneColumnID).Select
Selection.Copy
Range(groupOneColumnID).Offset(0, 1).Select '1 column to right
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

'20 col: (10 sets of 2), COPY: Paste-Values to right 2 cols
Columns(groupTwoColumnID).Select
Selection.Copy
Range(groupTwoColumnID).Offset(0, 2).Select '2 columns to right
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

'double col: (1 set of 2), COPY: Paste-Values to different section
Columns(groupThreeSourceID).Select
Selection.Copy
Range(groupThreeDestinationID).Select 'to new destinatin
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

Range("D2").Select 'NEW date, cell has: ?
Selection.Copy
Range(DateCellAddress).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Range(testCellAddress).Select
Selection.ClearContents
End If


Dim rem1ColumnID As String 'NEW: REMOVE CHARACTERS, rem: n/a, 0
Dim rem2ColumnID As String 'rem: x
Dim rep1CellID As String 'rep value month 1-9abc, designated by hand
rem1ColumnID = Range("B7")
rem2ColumnID = Range("B13")
rep1CellID = Range("C13")

If Range(testCellAddress).Value = "R" Then ' NEW: Remove Characters

Columns(rem1ColumnID).Select
Selection.Replace What:="n/a", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns(rem2ColumnID).Select
Selection.Replace What:="x", Replacement:=rep1CellID, LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Range(testCellAddress).Select
Selection.ClearContents
End If
End Sub
 
F

FSt1

hi
you can't put a sub within a sub as least not like you are trying to do.
the sub you are trying to add should be a seperate sub then use the call
command to call the sub when(if) needed.

If Range(testCellAddress).Value = "X" Then
Call Worksheet_GetData
'rest of your code

regards
FSt1
 
B

Bob Phillips

FSt1 said:
hi
you can't put a sub within a sub as least not like you are trying to do.
Click to expand...

You can sort of.


Sub Caller()
Dim x
x = Int(Rnd() * 100) + 1
If x > 50 Then GoSub SubInASub
x = 3
Exit Sub
SubInASub:
MsgBox "SubInASub called"
End Sub


Not sure if this addresses the OP's problem; not saying you should do it;
not saying you shouldn't do it; just saying that you can.
 
N

Nastech

hi - thanks, gave that a try. how do I terminate that, not: End Sub ??
on trying to use an item below it: "M" for move data, got error:
compile error, sub or function not defined.

and items hilited:
2nd line: Private Sub CommandButton1_Click() ' yellow, and:
Call Worksheet_GetData
 
N

Nastech

am novice to macro's.

FSt1 said:
hi
you can't put a sub within a sub as least not like you are trying to do.
the sub you are trying to add should be a seperate sub then use the call
command to call the sub when(if) needed.

If Range(testCellAddress).Value = "X" Then
Call Worksheet_GetData
'rest of your code

regards
FSt1
Click to expand...
 
N

Nastech

hi, sorry am at least little bit novice, guesse I insert my macro(?)
inbetween this somewhere? (dim means dimension? do I have to define that,
or is that for my button specified cell.. = "X" ?) thanks.
 
F

FSt1

hi
the call command terminates itself.
when called the start macro turns contol of code over to the called macro.
the called macro run until it hits it's end sub at which time, the called
macro ends and turns control back to the callilng macro which will run until
it hits it's end sub. no additional code required. just the call command.

Regards
FSt1
 
F

FSt1

hi
i was told along time ago that it couldn't be done but apparently i am
corrected. but i would still lean towards the "shouldn't be done" side just
to maintain logic.
besides, for this case, the op admits his a novice so i'll stand by my
recomendation.

thanks for the tip.
regard
FSt1
 
N

Nastech

thanks for the reply. am I entering it in the wrong spot?
gett error:

compile error, sub or function not defined


when hit button, (works with "M" in specified cell), works in main sheet.
but not in sheet with posted script. (adding "X").

even if my script "X" (same button) does not work yet. get above error.
if because of my "X" sub isn't written correctly yet. "M" should still work?

PASTING MY EXAMPLE AT BOTTOM, would think problem maybe with how End Sub,
but don't know.

FSt1 said:
hi
the call command terminates itself.
when called the start macro turns contol of code over to the called macro.
the called macro run until it hits it's end sub at which time, the called
macro ends and turns control back to the callilng macro which will run until
it hits it's end sub. no additional code required. just the call command.

Regards
FSt1
Click to expand...



Option Explicit
Private Sub CommandButton1_Click()
Dim testCellAddress As String '"DN6" from B1
Dim singleColumnID As String 'B2
Dim groupOneColumnID As String 'B3
Dim groupTwoColumnID As String 'B4
Dim groupThreeSourceID As String 'B5
Dim groupThreeDestinationID As String 'B6
Dim DateCellAddress As String 'date

'address must remain stable. get active sheet values or reference
different sheet in similar fashion:
'testCellAddress=Worksheets("AnotherSheetName").Range("B1")

testCellAddress = Range("B1") ' cell has:
=SUBSTITUTE(SUBSTITUTE(CELL("address",$DN$6),"$",""),"","")
singleColumnID = Range("B2") ' .Values are implied
groupOneColumnID = Range("B3")
groupTwoColumnID = Range("B4")
groupThreeSourceID = Range("B5")
groupThreeDestinationID = Range("B6")
DateCellAddress = Range("D3") 'date


' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ' Work area (between X's), AM
SURE DOES NOT WORK YET

' If Range(testCellAddress).Value = "X" Then 'PROBLEM: unexpected sub,
generally correct as below
' Private Sub Worksheet_GetData(ByVal Target As Excel.Range) 'PROBLEM:
tried ~7 variations

If Range(testCellAddress).Value = "X" Then
Call Worksheet_GetData

Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer
Dim Column1ID As String 'my addition, variables (url..?s=) below
Dim Column2ID As String 'my addition, DESTINATION
Dim topRowID As String 'my addition

Column1ID = Range("E4") 'has:
=SUBSTITUTE(SUBSTITUTE(CELL("address",$AU4),"$",""),ROW(),"")
Column2ID = Range("E5") 'has:
=SUBSTITUTE(SUBSTITUTE(CELL("address",$EE4),"$",""),ROW(),"")
topRowID = Range("C6") 'top of grid, should I modify for rows in grid
to a range?
'C4 ALTERNATIVE / USE cells column AU that do not have ".", C6 has:
=ROW($A$139)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Set DataSheet = ActiveSheet

' ---------- my addition, if correct idea? need to mix with next section
With Target
If .Count > 1 Then Exit Sub
If Target.Row < topRowID Then Exit Sub
' If Me.Cells(.Row, "A").Value = "." Then Exit Sub 'need to change
to indirect with Column1ID
If Me.Cells(.Row, Column1ID).Value = "." Then Exit Sub 'will see if
this is correct

' ---------- end my addition, this old version works in separate file:

'i = 4 ' PROBLEM 1: need help with integer references, per above,
start row is not row 4..
'qurl = "http://website?s=" + Cells(i, 1)
'i = i + 1
' While Cells(i, 1) <> ""
'While Cells(i, 1) <> "." 'cells not = "." in column AU MY ADDITION
may not be correct
' qurl = qurl + "+" + Cells(i, 1)
' i = i + 1
'Wend

'qurl = qurl + "&f=" + Range("E2") 'find format tags in cell
'Range("E3") = qurl 'place string in cell

' ---------- new version, haven't tested yet, cannot use button for item
below, for error above, unexpected sub?
' Problem?: max lines allowed per download is 190 (200) not sure if
working. can designate start and stop rows..

lr = Cells(2, Column1ID).End(xlDown).Row
For i = 1 To lr
'MsgBox Cells(i, "a")
qurl = "http://finance.yahoo.com/d/quotes.csv?s=" + Cells(i, 1)
Next i

qurl = qurl + "&f=" + Range("E2") 'find format tags in cell
Range("E3") = qurl 'place string in cell

' ---------- end new, following orig: (except for Column2ID was: "C4")

QueryQuote: 'PROBLEM 2: C4, need use of Column1/2ID and.. ?
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl,
Destination:=DataSheet.Range(Column2ID))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
'PROBLEM 2: C4
Range("C4").CurrentRegion.TextToColumns
Destination:=Range(Column2ID), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False

' Application.Calculation = xlCalculationAutomatic 'leave off
' Application.Calculate 'for use in my sheet
Application.DisplayAlerts = True
' Columns("C:C").ColumnWidth = 5.14
Range("A1").Select 'place cursor in cell

End Sub
End If

' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX


If Range(testCellAddress).Value = "M" Then 'MOVE DATA
'1 col: copy Paste-Values to left 1 col
Columns(singleColumnID).Select
Selection.Copy
Range(singleColumnID).Offset(0, -1).Select '1 column to left
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

'22 col: (main, 21 col back up), COPY: Paste-Values to right 1 col
Columns(groupOneColumnID).Select
Selection.Copy
Range(groupOneColumnID).Offset(0, 1).Select '1 column to right
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

'20 col: (10 sets of 2), COPY: Paste-Values to right 2 cols
Columns(groupTwoColumnID).Select
Selection.Copy
Range(groupTwoColumnID).Offset(0, 2).Select '2 columns to right
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

'double col: (1 set of 2), COPY: Paste-Values to different section
Columns(groupThreeSourceID).Select
Selection.Copy
Range(groupThreeDestinationID).Select 'to new destinatin
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False

Range("D2").Select 'NEW date, cell has: ?
Selection.Copy
Range(DateCellAddress).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

Range(testCellAddress).Select
Selection.ClearContents
End If


Dim rem1ColumnID As String 'NEW: REMOVE CHARACTERS, rem: n/a, 0
Dim rem2ColumnID As String 'rem: x
Dim rep1CellID As String 'rep value month 1-9abc, designated by hand
rem1ColumnID = Range("B7")
rem2ColumnID = Range("B13")
rep1CellID = Range("C13")

If Range(testCellAddress).Value = "R" Then ' NEW: Remove Characters

Columns(rem1ColumnID).Select
Selection.Replace What:="n/a", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Columns(rem2ColumnID).Select
Selection.Replace What:="x", Replacement:=rep1CellID, LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Range(testCellAddress).Select
Selection.ClearContents
End If
End Sub
 
N

Nastech

hi, is my error for something else? still get compile / sub error.

would think might say: End Call or something
 
F

FSt1

hi
you didn't remove all the code of Private Sub Worksheet_GetData to a
seperate module. the call command will be looking for a seperate module to
run.

Regards
FSt1
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

help with: MACRO / SCRIPT for button 3
help with EXCEL SCRIPT 0
Error with calling Format sub 7
Check URL exists in Webquery 4
Excel file using unusual amunt of resources 3
help with script for internet download 0
Setting Range with a Loop 1
INDIRECT Question.. 0

Top