Sub testmac()
'
' testmac Macro
'
'
ActiveWorkbook.Names.Add Name:="items", RefersToR1C1:= _
"=Report!R7C8:R486C11"
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=path
), Array("P;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;")), Destination:= _
Range("$A$1")).QueryTable
.CommandText = Array( _
"TRANSFORM first(`Dimension Value Code`)" & Chr(13) & "" & Chr(10) & "SELECT items.`No#`, items.`Description`" & Chr(13) & "" & Chr(10) & "FROM items" & Chr(13) & "" & Chr(10) & "GROUP BY items.`No#`, items.`Description`" & Chr(13) & "" & Chr(10) & "PIVOT `Dimension Code`" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_Excel_FilesXY"
.Refresh BackgroundQuery:=False
End With
End Sub
I am trying to make a pivot table with this code. The first try went well as it had no sheets. When I tried for the second time it gave me an error as the sheet already existed with table in it having the same name as the previous one.
The error is
Run-time error '1004': Application-defined or object defined error
When I delete the worksheet created in the previous step and try running the macro again works properly, but it does not works without deleting it.
you can try this at the top:
on error resume next
ActiveWorkbook.Sheets("your sheet").delete
on error goto 0
if it exists, it will be deleted and your code will make the new one. Does it help?
Related
Sub OPInport(month As Integer, year As Integer)
'
' Macro6 Macro
'F und G
'
Dim selectedRange As Date
Dim WrkBook As Workbook
Dim WrkSheet As Worksheet
Set WrkBook = ActiveWorkbook
Set WrkSheet = ActiveSheet
selectedRange = DateSerial(year, month, 1)
MsgBox selectedRange
WrkBook.Sheets(1).Columns("G:H").NumberFormat = "dd.mm.yyyy"
Range("$A$1").Value = "Change"
Application.CutCopyMode = False
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"ODBC;DSN=OpsApps;UID=Alligatoah;Trusted_Connection=Yes;APP=Microsoft Office 2016;WSID=AT000616;DATABASE=OpsApps" _
, Destination:=Range("$B$1")).QueryTable
.CommandText = Array( _
"SELECT IPM_V_TV_URB.Customer, IPM_V_TV_URB.KNUM, IPM_V_TV_URB.DMRF, IPM_V_TV_URB.HeaderBoM, IPM_V_TV_URB.ProgramReleasedCosts, IPM_V_TV_URB.PlnLaunch, IPM_V_TV_URB.SystemSDate, IPM_V_TV" _
, _
"_URB.ActualCosts" & Chr(13) & "" & Chr(10) & "FROM OpsApps.dbo.IPM_V_TV_URB IPM_V_TV_URB" & Chr(13) & "" & Chr(10) & "WHERE (IPM_V_TV_URB.SystemSDate>={ts selectedRange & 00:00:00'})" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_OpsApps"
.Refresh BackgroundQuery:=False
End With
I want to select a specific range of data, but when i try to do that it says "Runtime Error 1004 General ODBC Error" and points out the last line, .Refresh BackgroundQuery:=False. Im quite new to VBA and cant really find a solution to the problem. It only started showing that error message when i changed the date in the where question with selectedDate.
You need to concatenate the selected date into your string - what you are doing currently is using the literal name of the variable as a date.
"_URB.ActualCosts" & Chr(13) & "" & Chr(10) & "FROM OpsApps.dbo.IPM_V_TV_URB IPM_V_TV_URB" & Chr(13) & "" & Chr(10) & "WHERE (IPM_V_TV_URB.SystemSDate>={ts '" & Format(selectedRange, "yyyy-mm-dd") & " 00:00:00'})"
You may need to change the date format used.
I am pretty new to VBA and am learning how to add connections to databases in excel. I currently have a macro that creates a query called "Query1" it then queries my database and returns the correct table. I would like to be able to delete the query after the table is output to the excel sheet so that I can run the macro again with slightly modified conditions eg different dates.
Sub Macro2()
'
' Macro2 Macro
'
ActiveWorkbook.Queries.Add Name:="Query1", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Odbc.Query(""dsn=Database"", ""SELECT DISTINCT c.IP_TREND_VALUE AS """"PRODUCT"""", c.IP_TREND_TIME , s.IP_TREND_TIME AS TIMES, s.IP_TREND_VALUE AS """"Wttotal""""#(lf)FROM """"Product"""" AS c , """"wtTotal"""" as s#(lf)#(lf)Where #(lf)#(tab) c.TIME Between '1-JUN-17 05:59:00' AND '2-" & _
"JUN-17 05:59:00' AND c.TIME = s.IME#(lf)"")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " Source" & _
""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Query1" _
, 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
End Sub
I would like to add something like the following after the table is placed into the worksheet
ActiveWorkbook.Queries.Delete = Name: = "Query1"
But obviously this doesn't exist. How can I remove the query or make it so that the macro can be run without having to delete "Query1"?
Try adding the following line.
The Activeworkbook.Queries() takes a Name or Index
ActiveWorkbook.Queries("Query1").Delete
try this:
For Each Worksheet In ThisWorkbook.Worksheets
Qcount = Worksheet.QueryTables.Count
If Qcount > 0 Then
For Each QueryTable In ws.QueryTables
QueryTable.Delete
Next
End If
Next Worksheet
Delete all Queries in an Excel Workbook using
Dim Qus As WorkbookQuery
For Each Qus In ActiveWorkbook.Queries
Qus.Delete
Next
I have code that creates a query table. After creating it I pull out the data I want and then I'm done with that query. I don't want a bunch of query tables hanging around taking up space so I want to immediately delete it. I use
QueryTables.Delete
ActiveWorkbook.Connections.Item(i).Delete
The problem is that the query table connection is still there. So if I try to make another query using the same name, it tells me that one already exists and it can't make it.
I want any record of that table existing to be completely gone.
Here is my code:
Sub Macro8()
Dim currency1 As String
Dim currency2 As String
currency1 = ActiveSheet.Range("currency1")
currency2 = ActiveSheet.Range("currency2")
Range("clear").Select
Selection.ClearContents
ActiveWorkbook.Queries.Add Name:="FXFWD", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""http://www.investing.com/currencies/" & currency2 & "-" & currency1 & "-forward-rates""))," & Chr(13) & "" & Chr(10) & " Data0 = Source{0}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data0,{{"""", type text}, {""Name"", type text}, {""Bid"", type number}, {""Ask"", type number}, {""High"", type number}, {""Low"", type number}, {""Chg."", type number}, {""Time""," & _
" type text}})," & Chr(13) & "" & Chr(10) & " #""Removed Columns"" = Table.RemoveColumns(#""Changed Type"",{""""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Removed Columns"""
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Book1"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=FXFWD" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [FXFWD]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.ListObject.DisplayName = "FXFWD"
.Refresh BackgroundQuery:=False
End With
Sheets("Book1").Rows("1:33").Copy
Sheet1.Rows("18").PasteSpecial xlPasteValues
Sheets("Book1").Select
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim con As Object
Dim ws As Worksheet
Dim qryT As QueryTable
For Each con In ThisWorkbook.Connections
con.Delete
Next con
For Each ws In ThisWorkbook.Worksheets
For Each qryT In ws.QueryTables
qryT.Delete
Next qryT
Next ws
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Sheet1.Select
End Sub
For Each qr In ThisWorkbook.Queries
qr.Delete
Next qr
I have this Sub with which I receive data from external connection. I already specified a date range :
((infactln.dtransact>{d '2015-09-01'}) AND (infact.dtransact<{d '2015-09-30'}))
I want this sub to give the user the possibility to change this date range without going in "Data - Connections - Properties"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Visual FoxPro Tables;UID=;;SourceDB=\\serverName\data.dbc;
SourceType=DBC;Exclusive=No;Background" _
), Array("Fetch=Yes;Collate=Machine;Null=Yes;Deleted=Yes;")),
Destination:= _Range("$A$1")).QueryTable.CommandText = Array(
_"SELECT infact.ctransid, infact.ccode, infactln.dtransact,
infactln.ccode, infactln.cdesc, infactln.bqte, infactln.bmontant,
infactln.bcoutant" & Chr(13) & "" & Chr(10) & "FROM infact infact,
infactln infactln" & Chr(13) & "" & Chr(10) & "WHERE infact.kid =" _
, _" infactln.cparentid AND ((infactln.dtransact>{d '2015-09-01'}) AND
(infact.dtransact<{d '2015-09-30'}))" _)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_Visual_FoxPro_Tables"
.Refresh BackgroundQuery:=False
End With
You can (and should) use Format function:
https://msdn.microsoft.com/en-us/library/office/gg251755.aspx
Than you just give the user opportunity to specify specific dates in some cells, let's say these are "A1" and "B1". You just substitute the date values in your query with
" infactln.cparentid AND ((infactln.dtransact>{d '" & Format(Cells(1, "A"), "yyyy-MM-dd") & "'}) AND
(infact.dtransact<{d '" & Format(Cells(1, "B"), "yyyy-MM-dd") & "'}))"
i'm fighting with a problem..
i've got a VBA macro in excel 2013 (made in 2007 and worked fine in 2010)
it's scripted in SQL.
here is a bit of the code where the error is
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"ODBC;DRIVER=SQL Server Native Client 10.0;SERVER=APP14A\ISAHSERVER;UID=reader;PWD=reader;;DATABASE=ProduktieDB;", Destination _
:=Range("$A$7")).QueryTable
.CommandText = Array( _
"SELECT T_DossierMain.OrdNr, T_DossierDetail.DetailCode, T_DossierDetail.Description, T_DossierDetail.PartCode, T_DossierDetail.CalcQty, T_DossierDetail.DiscPerc, T_DossierDetail.CurrPrice" & Chr(13) & "" & Chr(10) & "FROM ProduktieDB.dbo.T_DossierDetail T_DossierDetail, ProduktieDB" _
, _
".dbo.T_DossierMain T_DossierMain" & Chr(13) & "" & Chr(10) & "WHERE T_DossierDetail.DossierCode = T_DossierMain.DossierCode AND ((T_DossierMain.OrdNr= '" & VariableOrderNo & "' ))" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Hoofdregels_Ophalen"
.Refresh BackgroundQuery:=False
End With
If IsEmpty(Range("A8").Value) Then
MsgBox "De order bestaat niet of heeft geen regels!"
Exit Sub
End If
so the problem is that i'm getting the error on the line ".refresh BackgroundQuery:=False
and if i remove that line, it will keep printing stuff
help?
regards,
michael
EDIT: i've found the problem.. this macro was made in 2007 so the only thing i had to do was changing the ".PreserveFormatting = False > True
thanks anyway =)