Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
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").Ra nge("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 |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
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 "Nastech" wrote: 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").Ra nge("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 |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
"FSt1" wrote in message
... hi you can't put a sub within a sub as least not like you are trying to do. 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. |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
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 "FSt1" wrote: 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 "Nastech" wrote: 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").Ra nge("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 |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
am novice to macro's.
"FSt1" wrote: 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 "Nastech" wrote: 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").Ra nge("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 |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
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. "Bob Phillips" wrote: "FSt1" wrote in message ... hi you can't put a sub within a sub as least not like you are trying to do. 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. |
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
allrignt, see dim x, told ya I was slow. still not sure where to insert.
thanks. "Nastech" wrote: 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. "Bob Phillips" wrote: "FSt1" wrote in message ... hi you can't put a sub within a sub as least not like you are trying to do. 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. |
#8
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
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 "Nastech" wrote: 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 "FSt1" wrote: 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 "Nastech" wrote: 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").Ra nge("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 |
#9
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
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 "Bob Phillips" wrote: "FSt1" wrote in message ... hi you can't put a sub within a sub as least not like you are trying to do. 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. |
#10
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
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" wrote: 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 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").Ra nge("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 |
#11
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
hi, is my error for something else? still get compile / sub error.
would think might say: End Call or something "FSt1" wrote: 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 "Nastech" wrote: 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").Ra nge("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 |
#12
Posted to microsoft.public.excel.misc
|
|||
|
|||
Help with script: STARTING A NEW SUB.. (within sub?)
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 "Nastech" wrote: 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" wrote: 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 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").Ra nge("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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
I need some VB script please | Excel Discussion (Misc queries) | |||
VB Script | Excel Worksheet Functions | |||
VB script help - please!! | Excel Discussion (Misc queries) | |||
VBA script help..Please !!!! | Excel Discussion (Misc queries) | |||
VB script help..please !! | Excel Worksheet Functions |