help with: MACRO / SCRIPT for button


N

Nastech

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
 
Ad

Advertisements

D

Don Guillett

If you are asking about the loop try this idea

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

Nastech

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").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
' 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
 
Ad

Advertisements

N

Nastech

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").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
' 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
 

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

Top