Dynamically Change pivot table source data - vba

I have a pivot table within an Excel 2010 workbook and the source changes everyday and gets outputed onto another excel workbook with name format as: "filename_MM.DD.YYYY.xlsx"
I have tried the following
Set ws1 = Worksheets("GRAPH")
Set ws2 = Worksheets("COC")
Set ws3 = Worksheets("LC")
Dim file_path As String
Dim file_name As String
Dim year As String
Dim day As String
Dim month As String
Dim project As String
Dim full_name As String
file_path = Sheets("Master").Range("F" & rep1).Value
file_name = Sheets("Master").Range("G" & rep1).Value
output_sheet = Sheets("Master").Range("L" & rep1).Value
year = Sheets("Master").Range("M" & rep1).Value
month = Format(Sheets("Master").Range("I" & rep1).Value, "00")
day = Format(Sheets("Master").Range("L" & rep1).Value, "00")
project = Sheets("Master").Range("B1").Value
full_name = Sheets("Master").Range("N10").Value
ws1.Activate
ActiveSheet.PivotTables("PivotTable2").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"\\JLR1GBMDCZZZB5J\SebServer\BOM_CAD_SCRIPT\project\2016\06 \22\full_name BOM'!$D:$CC" _
, Version:=xlPivotTableVersion15)
Next rep1
So the full_name is the full name of the file, project is the name of the folder and so on. This is all located in a sheet called 'Master' and pulls in the data from there.
But when changing the data source it does not work.
The source will change everyday and will be in a new folder with the new date every day, once a day.
Please Help
Thank you

The SourceData argument you have in your code is:
SourceData:="\\JLR1GBMDCZZZB5J\SebServer\BOM_CAD_SCRIPT\project\2016\06 \22\full_name BOM'!$D:$CC"
As this is all contained in "" you are passing this whole argument as a single string word for word every time you run your code without any change. I can see that within this you have written the names of a couple of your variables in attempt to change this value each time you run your code, in order to achieve this you need to append this like so:
SourceData:="\\Start of the filepath\" & aVariableFromYourMacro & "\end of the filepath"
in your case you are looking for something like the following:
SourceData:="\\JLR1GBMDCZZZB5J\SebServer\BOM_CAD_SCRIPT\" & project & "\" & year & "\" & month & "\" & day & "\" & full_name & " BOM'!$D:$CC"
In this example I have placed your variables in where the project, full_name and date labels were in the original string. You may need to modify this to get it to work how you like however hopefully from this example you can understand what you need to do.

Related

Keeping correct time format when uploading Excel data to Mysql database

I have the excel data in the following format:
When I click the UploadData button this data is uploaded into my connecting SQL database. This works when only uploading integers and strings, when I try to push dates to a database I get the following error:
When running the VBA code it appears to be ignoring the custom date format ("yyyy-mm-dd") that I apply the Date column in the Excel sheet so that it is in the correct format. How can I edit my VBA code so that the Date column data is in the "yyyy-mm-dd" format, it should have to do with the "query" variable in the For loop in my code I think, so that when it runs the query it sets the value of Date1 to the proper time format. NOTE: Under the query variable I included a formula I used in the excel sheet which allowed me to pull the Date value in the correct format, although I couldn't declare this properly in the VBA without getting errors
Sub UploadGsaData()
' Create the required variables
Dim query As String 'Variable for SQL query
Dim Date1 As String
Dim Address1 As String
Dim Mobile1 As Integer
Dim Salary1 As Integer
Dim TRow As Long
Dim CRow As Long
' Do not update the cells on the current sheet, this is performed after the SQL query
Application.ScreenUpdating = False
' Unprotect sheet to allow SQL changes to be made
ActiveSheet.Unprotect
' Send the ending row value
TRow = 7
' Inititate For Loop to iterate table of data
For CRow = 3 To TRow
Date1 = Sheets("Sheet1").Range("B" & CRow).Value
Address1 = Sheets("Sheet1").Range("C" & CRow).Value
Mobile1 = Sheets("Sheet1").Range("D" & CRow).Value
Salary1 = Sheets("Sheet1").Range("E" & CRow).Value
query = "REPLACE INTO testdata(Date, Address, Mobile, Salary) VALUES('" & Date1 & "', '" & Address1 & "', '" & Mobile1 & "', '" & Salary1 & "')"
'="REPLACE INTO operations_logbook(date_time, category, description, logged_by) VALUES('"&TEXT(B3,"yyyy-mm-dd")&"', '"&D6&"', '"&D10&"', '"&D8&"')"
' Call mysql query function to run query to upload log to database ( called a different name as different driver)
Call server_2_query_mysql_database(server2, database1, query, ActiveSheet.Range("A1"))
Next
' Reapply the Sheet protection now that the query is complete
ActiveSheet.Protect
' Update the Excel sheet so that any new data is updated
Application.ScreenUpdating = True
End Sub
Change this ...
Date1 = Sheets("Sheet1").Range("B" & CRow).Value
... to this ...
Date1 = Sheets("Sheet1").Range("B" & CRow).Text

Trying to identify and rename a file with an original name that contains a random number

Hi there I am trying to rename a file in a folder (with multiple similar files), but I have a hard time identifying it even with the wildcard method. The original file name looks like this: "2018_02_26_20180228_XXXXXX_GDW_Audit_CView_Report.txt" so my only way of identifying it is knowing parts of the name ("_GDW_Audit_CView_Report.txt") as the date is the same across multiple files. I wrote the following code which gives Path/File Access error when I try to run it. Any help would be appreciated.
Option Explicit
Sub HGDW_WKD()
Dim myDateTemp As String
Dim myDate1 As String
Dim myDate2 As String
Dim HGDW_CV1 As String
Dim HGDW_CV2 As String
myDateTemp = Format(Date, "yyyy-mm-dd")
myDate1 = Replace(myDateTemp, "-", "_")
myDate2 = Format(Date, "yyyymmdd")
HGDW_CV1 = myDate1 & "_" & myDate2 & "*_GDW_Audit_CView_Report.txt*"
HGDW_CV2 = "35999_HR_Global_Data_Warehouse_CView_PROD_" & myDate2 & ".txt"
Name "C:\Users\bf91955\SourceFldr\" & HGDW_CV1 As _
"C:\Users\bf91955\SourceFldr\" & HGDW_CV2
End Sub
I am not sure if this is what you mean but you can use the Dir function with wildcards to try and get the filename.
So say I had a file called
2018_02_28_20180228_XXXXXX_GDW_Audit_CView_Report.txt
I can retrieve the actual name as follows. First match. No real error handling if not found just test that string is assigned a value other than that which it was initialized with. You can pass the folder path as a variable.
Sub TEST()
Dim fname As String
fname = Dir("C:\Users\User\Desktop\Test\*_GDW_Audit_CView_Report.txt")
If fname <> vbNullString Then
Debug.Print fname
End If
End Sub
Example passing a folder variable and date1 (note date1 = "2018_02_28" as of this moment) :
Sub TEST()
Dim myDate1 As String
myDate1 = Format$(Date, "yyyy_mm_dd")
'Debug.Print myDate1
Dim fname As String
Dim folderPath As String
folderPath = "C:\Users\User\Desktop\Test"
fname = Dir(folderPath & Application.PathSeparator & myDate1 & "*_GDW_Audit_CView_Report.txt")
If fname <> vbNullString Then
Debug.Print fname
End If
End Sub
And why did I use Application.PathSeparator ? You should really test for the presence of a separator before trying to add one. In this case I used it for compatibility reasons. This will use the correct separator across Mac and Windows.
For info see here:
Excel 2016 Power Programming with VBA (2016)
Part IV. Developing Excel Applications , Chapter 21. Understanding Compatibility Issues
Quote:
If your code deals with paths and filenames, you need to construct
your path with the appropriate path separator (a colon for the Mac, a
backslash for Windows). A better approach is to avoid hard-coding the
path separator character and use VBA to determine it. The following
statement assigns the path separator character to a variable named
PathSep:
PathSep = Application.PathSeparator
Reference:
http://www.excelfunctions.net/vba-dir-function.html

Changing Day and Month to DD and MM format in VBA

To give some context here, I have a dat file that I am trying to save as an xlsx on my Q drive. I know that the majority of the code works (I've tested it), so I don't want to completely change it, but the formatting as I explain below is what I need help with. The following code is in workbook1 and it is referencing workbook2. Cell D3 in workbook one is a date formula but unfortunately, the FileDay and FileMonth code will only pull in a single "d" or "m" when what I want is it to pull in days and months in the "dd" and "mm" format. Since the code below is trying to find a file in this format: "yyyy_mm_dd" but FileDay and FileMonth are only pulling in "d" and "m", it will only work during part of the year. What is the piece of code that I am missing to pull in the correct formatting from cell D3?
Dim FName As String, FPath As String
Dim wkb1 As Workbook, wkb2 As Workbook
Set wkb1 = ThisWorkbook
FileDay = Day(Range("D3"))
FileMonth = Month(Range("D3"))
FileYear = Year(Range("D3"))
FPath = "Q:\MyFolder"
FName = "MyFile_" & FileYear & "_" & FileMonth & "_" & FileDay & ".xlsx"
Set wkb2 = Workbooks("MyFile_" & FileYear & "_" & FileMonth & "_" & FileDay
& ".dat")
With wkb2
.SaveAs Filename:=FPath & "\" & FName
.Close True
End With
End Sub
Assuming these variables are Strings, use the Format$ function.
FileDay = Format$(Day(Range("D3")), "00")
FileMonth = Format$(Month(Range("D3")), "00")
FileYear = Format$(Year(Range("D3")), "0000")
Alternatively, do it all at once:
= Format$(Range("D3"), "YYYY_MM_DD")

VBA: saving to specific path based on cell values

I made a macro to save an Excel file on a location based on some cell values.
But when I run the macro the file won't save.
The last line of the macro becomes yellow.
If I skip the dtMonth and dtMonthnumber the files saves just fine, so the problem is not dtYear, or Format(dtDate, "yymmdd").
Do I need to concert the cell values?
The formulas in the cells are to convert date to month and year:
U1 =TEXT(Controle!H6;"mmmm")
U2 =TEXT(Controle!H6;"jjjj")
U3 =TEXT(H6;"mm")
Dim dtDate As Date
dtDate = Date
Dim dtMonth As String
Dim dtYear As String
Dim dtMonthnumber As String
dtMonth = ThisWorkbook.Sheets("Controle").Range("U1")
dtYear = ThisWorkbook.Sheets("Controle").Range("U2")
dtMonthnumber = ThisWorkbook.Sheets("Controle").Range("U3")
Dim strFile As String
strFile = "M:\X-tra pakketten\" & dtYear & "\" & dtMonthnumber & " - " & dtMonth & "\" & Format(dtDate, "yymmdd") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=strFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Sounds like a VBA bug, where Breakpoints are sometimes not properly deleted. Try this:
Set a Breakpoint somewhere inside your procedure.
Change something inside your code, so it needs to recompile (for example add a Debug.Print "" somewhere)
Use the menu Debug > Delete all breakpoints (Ctrl+Shift+F9)
Recompile it
That should solve the problem. If it still doesn't work, copy your code somewhere, delete the module, create a new module and insert the code again.

Recursive search code optimization with vb.net

I have created a little program to search a set of folders holding documents scanned.
the folder structure is as follows:
c:\images\year\month\date\documenttype\firstpartofdocumentNo.\
the year folder contains years from 2005 - 2015
the month folder contains the months of the year (Obviously)
same with date
the documenttype folder can contain between 1 and 5 folders
the firstpartofdocumentno. can contain between 1 and 3 folders
the code I am using at the moment is :
CompName = Environment.MachineName
'MsgBox(CompName)
TicketNo = TxtTicketNo.Text
If CompName = "Comp1" Then
ImageDir = "C:\Images\"
Else
ImageDir = "\\Comp1\Images\"
End If
For Each DirYear As String In Directory.GetDirectories(ImageDir)
Dim YearInfo As New DirectoryInfo(DirYear)
For Each DirMonth As String In Directory.GetDirectories(DirYear)
Dim MonthInfo As New DirectoryInfo(DirMonth)
For Each DirDate As String In Directory.GetDirectories(DirMonth)
Dim DateInfo As New DirectoryInfo(DirDate)
For Each DirType As String In Directory.GetDirectories(DirDate)
Dim TypeInfo As New DirectoryInfo(DirType)
For Each DirStart As String In Directory.GetDirectories(DirType)
Dim StartInfo As New DirectoryInfo(DirStart)
MainDirectory = ImageDir & YearInfo.Name & "\" & MonthInfo.Name & "\" & DateInfo.Name & "\" & TypeInfo.Name & "\" & StartInfo.Name & "\"
'LstFiles.Items.Add(YearInfo.Name & "\" & MonthInfo.Name & "\" & DateInfo.Name & "\" & TypeInfo.Name & "\")
'Dim files() As String = Directory.GetFiles(MainDirectory, TicketNo & "*")
'For Each Ticket As String In Directory.GetFiles(MainDirectory, TicketNo)
For Each Ticket As String In Directory.GetFiles(MainDirectory, TicketNo & "*")
LstFiles.Items.Add(Ticket)
Next
'Next
Next
'MsgBox(files)
'LstFiles.Items.Add()
Next
'LstFiles.Items.Add(dirInfo.Name)
Next
Next
'MsgBox(ImageDir)
Next
I have a textbox on the form which is used to enter the last four numbers of the ticketno and then this code runs when the button is clicked.
The problem is it can take up to five minutes to search, so I was wondering if there is a way to optimize this code to speed it up a bit or does this sound about right for searching that many folders.
Thanks in advance
Gareth