I am new to VBA.
I am trying to extract all columns from other file but the result is displayed with error 13. How can I solve it?
Sub generate_data()
Application.CutCopyMode = False
Sheets("Output").Activate
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=HKGHKGT_UBET;Description=HKGHKGT_UBET;UID=SiuH;Trusted_Connection=Yes;APP=Microsoft Office 2016;WSID=HKHKDNO304NB;DATABASE=" _
), Array("UBet")), Destination:=Range("$A$1")).QueryTable
'CommandType = 0
.CommandText = Array("select * from UBet..cathy_fin where duns_no in(" & Sheets("Main").Range("A2").Value & ") order by stmt_date desc")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "HKGHKGT_UBET"
.Refresh BackgroundQuery:=False
End With
ActiveSheet.ListObjects("HKGHKGT_UBET").TableStyle = ""
Columns("B:B").Select
Selection.NumberFormat = "m/d/yyyy"
End Sub
Related
I am creating a SQL query to get data from an SQL database, but the macro recorder posts the data into a listobject. I want the query to post the data into an array instead of listobject.
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Query1;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Query1]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Query1"
.Refresh BackgroundQuery:=False
End With
I'm trying to download data from a weather website (weather.gov) and trying to use variables for the latitude and longitude in the URL. If I go to the website and switch out the latitude and longitude manually, I will be directed to the correct city's weather forecast. However, when I try to set the latitude and longitude as a variable and combine the part of the URL that doesn't change with the variables for each city, it give me a compile error, Expected: list separator or ). It keeps getting stuck on this section ("&lon=-") in the URL. I'm not sure if there's a better way to declare the variable or add them in, but it doesn't make much sense to me why it doesn't like that middle section. Code below. Thanks!
P.S. The cityLat and cityLong variables would be values based on the city, but for right now I just have the actual latitude and longitude just to test it with.
Sub forecast_weather()
Dim cityLon As String
Dim cityLat As String
cityLat = "41.8781"
cityLong = "87.6298"
ActiveWorkbook.Worksheets("Chicago Weather").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://forecast.weather.gov/MapClick.php?lat="&cityLat&"&lon=-
"&cityLong&"&unit=0&lg=english&FcstType=text&TextType=2", _
Destination:=Range("$A$1"))
.Name = "q?s=usdCAd=x_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
You need spaces around the &
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://forecast.weather.gov/MapClick.php?lat=" & cityLat & _
"&lon=" & cityLong & "&unit=0&lg=english&FcstType=text&TextType=2", _
Destination:=Range("$A$1"))
this gets Chicago weather
Sub forecast_weather()
Dim cityLon As String
Dim cityLat As String
cityLat = "41.8781"
cityLong = "-87.6298"
With Worksheets("sheet1").QueryTables.Add( _
Connection:="URL;http://forecast.weather.gov/MapClick.php?" _
& "lat=" & cityLat _
& "&lon=" & cityLong _
& "&unit=0&lg=english&FcstType=text&TextType=2", Destination:=Range("$A$1"))
.Name = "q?s=usdCAd=x_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
I'm trying to download datasheets for horses.
The only variable in the macro is a part of the URL.
I have all the variables (the horses numbers) listed in column "A".
I want to create a new sheet with the information collected from the website, and then collect information again using the numbers (new variable) from next row in column "A".
So far this is the code I have:
Sub Makro1()
'
' Makro1 Makro
'
Dim nummer As String
nummer = Sheets("Ark1").Range("A1:A10")
'
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://195.198.34.45/trav/hast/visa/" & nummer & "/resultat", Destination:=Range _
("$A$1"))
.CommandType = 0
.Name = "resultat"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Columns("D:D").Select
ActiveWindow.SmallScroll Down:=21
Columns("E:E").Select
Range("E22").Activate
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("D:D").Select
Range("D22").Activate
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=True, Semicolon _
:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="/", _
FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True
End Sub
User sheet trying to describe problem
a proposition on how to handle multiple query, not sure about what you want to do with each result
Sub Makro1()
'
' Makro1 Makro
'
Set ws = ActiveSheet 'sheet containing your numbers in column A
ActiveWorkbook.Worksheets.Add
For Each nummer In ws.Range("A1:A10")
If nummer.Text = "" Then Exit For
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://195.198.34.45/trav/hast/visa/" & nummer.Text & "/resultat", Destination:=Range("$A$1"))
.Name = "resultat"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = True
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
nummer.Offset(0, 1) = ActiveSheet.Cells(21, 1)
End With
Next
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End Sub
I have this VBA script that works:
Sub Basic_Web_Query()
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & ActiveSheet.Range("A2").Value, Destination:=Range("E2"))
.Name = "q?s=goog_2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
I want the macro to do this in a loop, i.e. go to A3 with destination E3, A4 with destination A4... etc.
any help will be appreciated
thansk!
I like to use 'offset' for these loops: OFFSET(rows down, columns right).
Negative values move up and left.
for example:
for p= 1 to 5
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & ActiveSheet.Range("A2").offset(p-1,0).Value, Destination:=Range("E2").offset(p-1,0))
'other code
End With
next p
google 'loop vba' and you will hit plenty of examples. Here's one:
Dim rw As Long
For rw = 1 To 5
Range("E" & rw).Value = Range("A" & rw).Value
'other stuff
Next rw
Does anyone know how to stop the refresh query table to constantly refreshing and only refresh itself once. he constant refresh, is making my excel spreadsheet run slow.
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & FilePath, _
Destination:=temp.Range("A1"))
.Name = "Deloitte_2013_08"
' .CommandType = 0
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Change this line:
.BackgroundQuery = True
to:
.BackgroundQuery = False
Use Application.ScreenUpdating to wrap your code.
application.screenupdating = false
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & FilePath, _
Destination:=temp.Range("A1"))
.Name = "Deloitte_2013_08"
' .CommandType = 0
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
application.screenupdating = true
You might also be interested in setting Application.Calculation to xlCalculationManual before a large operation and then setting it to xlCalculationAutomatic after you are done.