Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
help with: MACRO / SCRIPT for button
hi, I am trying to resove the use of script to my sheet, that usually
refferences a CELL C4.. instead I will look for data in a different column (AU), If there is a "." in column AU -or- if after a specified row, etc. then exit; already have some of the specified below (incorrectly mixed in I'm sure, is what need help with). with above, not sure how to mix with integer stuff. (not needed with my parameters?). thanks, "portion" working on: Option Explicit Private Sub CommandButton1_Click() If Range(testCellAddress).Value = "X" Then Sub GetData() Dim QuerySheet As Worksheet Dim DataSheet As Worksheet Dim qurl As String Dim i As Integer 'how use with this sheet? 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 ' ---------- my addition i = 4 ' need help with interger reference 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) < "" 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 |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
help with: MACRO / SCRIPT for button
|
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
help with: MACRO / SCRIPT for button
hi, thanks for the response; not up days.. slow to get back.
would guesse that is what am looking for, still trying to get to work. (not proficient with macros, tried to label all items I wrote) running into problem not had.. to make a sub to a sub? sure thats not right, but with use of button for multiple items (if a cell = a specific letter to make work for that function) with that, this example working on can't get started because of: UNEXPECTED SUB happens when trying to run a different use of button below it. thanks the script using so far: 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 ' THEORY AREA WORKING ON (between X's), AM SURE DOES NOT WORK YET ' Option Explicit ' Private Sub CommandButton1_Click() 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 'how use with this sheet? 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 'Range("C4").CurrentRegion.ClearContents 'no thanks, wipes out my sheet ' ---------- 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, following old: '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 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 '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 |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
help with: MACRO / SCRIPT for button
disregard previous post / delete
ok, forgot couple of items... (this little box we have to type in..) hi, thanks for the response; not up days.. slow to get back. would guesse that is what am looking for, still trying to get to work. (not proficient with macros, tried to label all items I wrote) running into problem not had.. to make a sub to a sub? sure thats not right, but with use of button for multiple items (if a cell = a specific letter to make work for that function) with that, this example working on can't get started because of: UNEXPECTED SUB happens when trying to run a different use of button below it. thanks the script using so far: 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 ' THEORY AREA WORKING ON (between X's), AM SURE DOES NOT WORK YET ' Option Explicit ' Private Sub CommandButton1_Click() 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 'how use with this sheet? 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 'Range("C4").CurrentRegion.ClearContents 'no thanks, wipes out my sheet ' ---------- 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, following old: '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 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro Script | Excel Discussion (Misc queries) | |||
Button/Script to create a new workbook from a current one. | Excel Worksheet Functions | |||
VB script/macro help - please !! | Excel Discussion (Misc queries) | |||
Macro script error - pls help !! | Excel Discussion (Misc queries) |