In General: I'm trying to create a sub that runs multiple queries. All of these queries are exactly similar except for one word: Column1. Therefore I'd like to use a loop and replace Column1 with a function GetColumnAct(x). The function should return Column1 when running the loop the first time, Column2 when running it the second time and so on...
Here's the code:
Sub ColumnLoop()
For x = 1 To 5
ActiveWorkbook.Queries.Add Name:=GetColumnAct(x), Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Quelle = Excel.Workbook(File.Contents(""C:\Users\felix\OneDrive\Dokumente\GIZ Consultancy\Technisch\Teststruktur\FV_MA_Abfragen\Aktuelle Abfrage NEU\MA_Daten_AktuelleAbfrageNEU.xlsx""), null, true)," & Chr(13) & "" & Chr(10) & " Tabelle1_Sheet = Quelle{[Item=""Tabelle1"",Kind=""Sheet""]}[Data]," & Chr(13) & "" & Chr(10) & " #""Höher gestufte Header"" = Table.PromoteHeaders(Tabelle1_Sheet, [PromoteAllScalars=true]" & _
")," & Chr(13) & "" & Chr(10) & " #""Spalte nach Trennzeichen teilen"" = Table.SplitColumn(#""Höher gestufte Header"", ""Mitarbeiter (eMail) TN-Projekt"", Splitter.SplitTextByDelimiter("","", QuoteStyle.Csv), {""MA.1"", ""MA.2"", ""MA.3""})," & Chr(13) & "" & Chr(10) & " #""Zusammengeführte Abfragen"" = Table.NestedJoin(#""Spalte nach Trennzeichen teilen"", {""TN Projekt""}, Tabelle1, {""TN Projekt""}, ""Tabelle1"", JoinKind.FullOuter)," & Chr(13) & "" & Chr(10) & " #""Erweiterte Tabelle1"" = Table.ExpandTableColumn(#""Zusammengeführte Abfragen"", ""Tabelle1"", {""TN Projekt"", ""Fachverbunds Nr."", ""TN Bezeichnung"", ""Fachverbundsbezeichnung"", ""MA.1"", ""MA.2"", ""MA.3""}, {""Tabelle1.TN Projekt"", ""Tabelle1.Fachverbunds Nr."", ""Tabelle1.TN Bezeichnung"", ""Tabelle1.Fachverbundsbezeichnung"", ""Tabelle1.MA.1"", ""Tabelle1.MA.2"", ""Tabelle1.MA.3""})," & Chr(13) & "" & Chr(10) & " #""Entfernte Spalten"" = Table.RemoveColumns(#""Erweiterte Tabelle1"",{""Tabelle1.TN Projekt"", ""Tabelle1.Fachverbunds Nr."", ""Tabelle1.TN Bezeichnung"", ""Tabelle1.Fachverbundsbezeichnung""})," & Chr(13) & "" & Chr(10) & " #""Tiefer gestufte Header"" = Table.Demote" & _
"Headers(#""Entfernte Spalten"")," & Chr(13) & "" & Chr(10) & " #""Transponierte Tabelle"" = Table.Transpose(#""Tiefer gestufte Header"")," & Chr(13) & "" & Chr(10) & " ColumnNext = #""Transponierte Tabelle"" [GetColumnAct(x)]," & Chr(13) & "" & Chr(10) & " #""In Tabelle konvertiert"" = Table.FromList(ColumnNext, Splitter.SplitByNothing(), null, null, ExtraValues.Error)," & Chr(13) & "" & Chr(10) & " #""Entfernte Duplikate"" = Table.Distinct(#""In Tabelle konvertiert"")," & Chr(13) & "" & Chr(10) & " #""" & _
"Entfernte leere Zeilen"" = Table.SelectRows(#""Entfernte Duplikate"", each not List.IsEmpty(List.RemoveMatchingItems(Record.FieldValues(_), {"""", null})))," & Chr(13) & "" & Chr(10) & " #""Transponierte Tabelle1"" = Table.Transpose(#""Entfernte leere Zeilen"")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Transponierte Tabelle1"""
Next x
End Sub
And the function is this:
Public Function GetColumnAct(ColNumber) As String
Dim ColumnAct As String
ColumnAct = "Column" & ColNumber
GetColumnAct = ColumnAct
End Function
The only problem is the inclusion of the function GetColumnAct(x) in the formula. While it works for the Argument Name:=GetColumnAct(x), (at the beginning) it doesn't work when included in Formula:=... (at the end).
Does anybody know why this is so? Maybe I'm just getting the syntax wrong? I'm super thankful for any help provided as I'm stuck on this mini thing the whole day now...
Here's the error message I get in advanced editor (power query):
invalid identifier
Try this:
Public Function GetColumnAct(ColNumber as Integer) As String
Dim ColumnAct As String
ColumnAct = "Column" & str(ColNumber)
GetColumnAct = ColumnAct
End Function
thanks again to everybody who looked into this!
I've now found the answer!
Instead of
#""Transponierte Tabelle"" [GetColumnAct(x)]," & Chr(13) & ""
I needed to write
#""Transponierte Tabelle"" [" & GetColumnAct(x) & "]," & Chr(13) & ""
Somebody told me at another website, so glad I've got it now!
It seems to be a problem with some characters in it
My original formula in the worksheet (working):
ThisWorkbook.Worksheets("Zazmluvnenia").Cells("3", "AM").Value = "=Výkony!M4 & ", " & TEXT(Výkony!J4;"d.m.yyyy") & ", " & TEXT(Výkony!K4;"hh:mm")"
Putting this into VBA doesn't work because of the quotes. I tried to solve the problem this way: How do I put double quotes in a string in vba?
I changed my code according to the answers on the question above:
"=Výkony!M3 & " & Chr(34) & ", " & Chr(34) & " & TEXT(Výkony!J3;" & Chr(34) & "d.m.yyyy" & Chr(34) & ") & " & Chr(34) & ", " & Chr(34) & " & TEXT(Výkony!K3;" & Chr(34) & "hh:mm" & Chr(34) & ")"
And error '1004' occurred.
Double Quotes vs CHR(34)
Your CHR solution was almost fine, but you didn't know that VBA doesn't recognize the semi-colon (;) as a separator like Excel does. You always have to replace every semi-colon (used as a separator) with a comma in VBA.
Similarly VBA uses the dot (.) as the decimal separator.
The Code
Option Explicit
Sub SEMI()
Dim strF As String
' Double double-quotes ("") in several rows.
strF = "=Výkony!M4&"", """ _
& "&TEXT(Výkony!J4,""d.m.yyyy"")&"", """ _
& "&TEXT(Výkony!K4,""hh:mm"")"
' CHR(34) in several rows.
strF = "=Výkony!M4&" & Chr(34) & ", " & Chr(34) _
& "&TEXT(Výkony!J4," & Chr(34) & "d.m.yyyy" & Chr(34) & ")&" _
& Chr(34) & ", " & Chr(34) _
& "&TEXT(Výkony!K4," & Chr(34) & "hh:mm" & Chr(34) & ")"
' Double double-quotes ("") in one row.
strF = "=Výkony!M4&"", ""&TEXT(Výkony!J4,""d.m.yyyy"")&"", ""&TEXT(Výkony!K4,""hh:mm"")"
' CHR(34) in one row.
strF = "=Výkony!M4&" & Chr(34) & ", " & Chr(34) & "&TEXT(Výkony!J4," & Chr(34) & "d.m.yyyy" & Chr(34) & ")&" & Chr(34) & ", " & Chr(34) & "&TEXT(Výkony!K4," & Chr(34) & "hh:mm" & Chr(34) & ")"
ThisWorkbook.Worksheets("Zazmluvnenia").Cells("3", "AM").Value = strF
End Sub
I have written some code that converts my Excel file into a XML data form, however I cannot figure out a way to save the new document to a specific location with a specific name.
So far I have tried to find some that will give me the option to save the filename, however everything I have found so far will only let me put in a path name when I attempt to save it. Like Document.Save "Path" will only allow me to save to the path location and will not keep the file name that I have stored in a variable.
xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
& "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
& " xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
& "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
& "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
& " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
& " <xsl:template match=" & Chr(34) & "node() | #*" & Chr(34) & ">" _
& " <xsl:copy>" _
& " <xsl:apply-templates select=" & Chr(34) & "node() | #*" & Chr(34) & " />" _
& " </xsl:copy>" _
& " </xsl:template>" _
& "</xsl:stylesheet>"
xslDoc.async = False
doc.transformNodeToObject xslDoc, newDoc
Dim Docname As String
Docname = "VMM_" & SN.Text
fileSaveName = GetSaveAsFilename(InitialFileName:=sItem * Docname, filefilter:="XML Files (*.xml),*xml")
newDoc.SaveAs Filename:= fileSaveName, FileFormat:=xlTextPrinter, CreateBackup:False
I found code that helped me convert my code to XML which is the first part of it, however I cant find out how to use the SaveAs with the newDoc which is a MSXML2.DOMDocument60. I'm trying to save it with the filename Docname, in the location which is called sItem, any help would be greatly appreciated
Hi i am trying to check for a specific character in visual vba but i encountered the "INVALID QUALIFIER" error when i run my code.
This is my code:
For i = LBound(rtv) To UBound(rtv) - 1
If rtv(i).Contains(":") Then
Value = Split(rtv(i), ":")
rtv(i) = Chr(34) & Value(0) & Chr(34) & ":" & Chr(34) & Value(1) & Chr(34) & ";"
Else
rtv(i) = Chr(34) & rtv(i) & Chr(34) & ":" & Chr(34) & Chr(34)
' rtv(i) = Chr(34) & rtv(i) & Chr(34) & ":" & Chr(34) & Chr(34) & ";"
Next i
The error lies in the IF statement condition but i have no idea what i am doing wrong here. Any help ?
As noted in the comments, rtv(i).Contains() won't work. Arrays don't have functions or properties that you can use this way.
Use this instead:
If InStr(rtv(i),":") > 0 Then
This code works as intended but I also need to exclude Autoreplies and some other strings in a subject line. I need to know if it's possible to add 2 or 3 more Likes.
I tried And and Or conditions but I'm getting a parse error.
This code below works. I just need to add another string condition after undeliverable. " Like '%Automatic reply%'".
Filter = "#SQL=" & " Not " & _
"urn:schemas:httpmail:subject" & "" & _
" Like '%undeliverable%'"
thanks.
OR Should work, The following Example have either %undeliverable% Or %Automatic reply%
Filter = "#SQL=" & " Not (urn:schemas:httpmail:subject" & _
" Like '%undeliverable%' Or " & _
"urn:schemas:httpmail:subject" & _
" Like '%Automatic reply%')"
To Add one more Filter
Filter = "#SQL=" & " Not (urn:schemas:httpmail:subject" & _
" Like '%undeliverable%' Or " & _
"urn:schemas:httpmail:subject" & _
" Like '%Automatic reply%' Or " & _
"urn:schemas:httpmail:subject" & _
" Like '%Bla Bla%')"