I'm trying to figure out how to rewrite my macro (that I use already to create files containing records based on a date) so that it continues to create separate files but based on an additional variable, e.g. on date and type.
Some additional input:
the date is selected by the user through a userForm containing 'Selected Date'; this value is passed on to the macro;
the type (as is the date), is part of the data record
Here's are the columns in the entire record:
Date
Type
Product
Currency
Id
20210401
1
A
EUR
1548
20210401
2
A
EUR
1579
20210401
1
A
EUR
1589
Using the table above, I would like to create separate files called FILE_20210401_1.txt and FILE_20210401_2.txt file creation is controlled by a) the date, and b) the type. This means my first file would contain 2 records, the latter only 1.
All goes fine with regard to file names and storing the files.
The content, however, is the bottleneck, as the macro now includes all records in both files. I have tried many things using a loop and a double loop, but I guess I'm missing something to tell the macro i want to have a file grouped per date and type. This is what I have so far in the macro:
Sub
Dim sRange As Range
Dim i As Long
Dim m As Long
Dim SelectedDate As String
Dim TDate As String
Dim Type As Variant
SelectedDate = Range("AA2").Value 'Selected Date entered on the userForm
Set sRange = Range("A2:E4").Cells(1, 1).CurrentRegion
If TDate = SelectedDate Then
For i = 2 To sRange.Rows.Count
'set date column
TDate = sRange.Range("A" & i) 'TDate is in column A of the range
For m = 2 To sRange.Rows.Count
Type = sRange.Range("B" & m) 'Type is in column B of the range
'define directories and file location
If Len(Dir(MyFolder1, vbDirectory)) <> 0 Then
If Len(Dir(MyFolder2, vbDirectory)) <> 0 Then
If Len(Dir(MyFolder3, vbDirectory)) <> 0 Then
filename = MyFolderFull & "\FILE_" & SelectedDate & "_" & Type & ".txt"
Else: MkDir MyFolder3
filename = MyFolderFull & "\FILE_" & SelectedDate & "_" & Type & ".txt"
End If
Else: MkDir MyFolder2
MkDir MyFolder3
filename = MyFolderFull & "\FILE_" & SelectedDate & "_" & Type & ".txt"
End If
Else: MkDir MyFolder1
MkDir MyFolder2
MkDir MyFolder3
filename = MyFolderFull & "\FILE_" & SelectedDate & "_" & Type & ".txt"
End If
Open filename For Output As #1
Print #1
Close #1
Next m
Next i
End if
MsgBox "Files created!"
End Sub
Any ideas as to what I am forgetting here?
Your code contains:
Open filename For Output As #1
It should be:
filename = "FILE_" & CStr(TDATE) & "_" & CStr(i)
Open filename For Output As #1
(Something like that, I didn't test it)
Related
I currently have a log file that get generated when you click on a button.
At the beginning of the .log you have a preview with different information such as the login, url of a server etc... But you also have the date of the beginning of the process and the date for the end. Both are in the long date format and are displayed correctly in the log file.
That log file takes the information from a sheet the preview part is static and is a range ("A1:C13") and the rest of the log is beneath but still in the columns ("A:C").
The cells in excel :
I want to add a line that shows the difference between the two date, to quickly see the time the process took.
However when I'm creating the log file, I get the time difference in number.
eg : in excel the cell with the format shows 00:01:55 but in the log file I get 0,001331
The output in the .log :
So far I tried :
To force the format in vba when the export in processing
To copy/paste in value with the hour format to not show the subtraction in the cell
different kind of format but it wasn't conclusive
You'll find the code that create the log file here :
Private Sub iExportLog(Optional LogPath As String, Optional bouton As String)
Dim NF As Integer, C As Range, posi As Integer
Dim date_nom As String
Dim drct As String
NF = FreeFile
drct = ThisWorkbook.path & "\_LogELB"
Set C = iFLog.Range("A1")
' iFLog = the sheet
' Things I tried :
'iFLog.Range("C12") = Format(iFLog.Range("C11").Value - iFLog.Range("C2").Value, "hh:mm:ss")
'iFLog.Range("C12").NumberFormat = "hh:mm:ss"
'
posi = InStrRev(ThisWorkbook.Name, ".")
If Dir(drct, vbDirectory) = "" Then MkDir (ThisWorkbook.path & "\" & "_LogElb")
date_nom = Format(CStr(Now), "yyyy_mm_dd_hh_mm_ss_")
If LogPath = "" Then LogPath = drct & "\" & bouton & "_" & date_nom & ".log"
Open LogPath For Append As #NF
Do While C.Value <> ""
Print #NF, C.Value & vbTab & vbTab & vbTab & C.Offset(0, 1).Value & vbTab & C.Offset(0, 2).Value
Set C = C.Offset(1, 0)
Loop
Close #NF
End Sub
I don't have a lot of practice with manipulating dates but I know that it can be painful.
Is there a way to display a date subtraction correctly when generating a .log/.txt file ?
If you write a formatted time string to a cell then Excel will interpret that as a time value and "undo" your formatting, converting the value back to a numeric value (though the display format may hide that).
If you want to keep the "hh:mm:ss" format then first set the cell format to "Text", or prepend the string with ' before placing it in the cell. Or read the cell's Text property instead of Value
I'm trying to create a list of folders, based off row data in Excel.
Obviously I've copied this common code from elsewhere.
It worked the first time I used it, but when I went to create another run of folders, it spit out this error: "run time error 76: path not found"
I've saved the file into its own new folder, so the only thing that exists in the folder is the excel workbook.
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then _
MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
Thanks
I've tried your code and it creates the folders as expected.
Here's what I executed:
Sub MakeFolders()
Dim Rng As Range
Dim maxRows As Integer, maxCols As Integer, r As Integer, c As Integer
Set Rng = Selection
maxRows = Rng.Rows.Count
maxCols = Rng.Columns.Count
For c = 1 To maxCols
r = 1
Do While r <= maxRows
If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
On Error Resume Next
End If
r = r + 1
Loop
Next c
End Sub
Note that I adjusted your second Dim statement to include the data type for each variable as that seemed your intent. Without including "as Integer" for each variable, all but the last variable in the list was being declared as "variant" instead of "integer".
You definitely want to remove the "on error resume next" statement. Once that line executes, it is suppressing any error message that you would otherwise see to help you find the issue.
My best guess is that you have illegal characters in the data you are using to create the folders. Be sure that none of your folder names include the following characters as they are all disallowed in folder names
< (less than)
> (greater than)
: (colon)
" (double quote)
/ (forward slash)
\ (backslash)
| (vertical bar or pipe)
? (question mark)
* (asterisk)
I've provided a simplified version of your code in case it is of use.
Sub MakeFolders2()
Dim cell As Range
For Each cell In Selection
If Len(Dir(ActiveWorkbook.Path & "\" & cell.value, vbDirectory)) = 0 Then
MkDir (ActiveWorkbook.Path & "\" & cell.value)
End If
Next
End Sub
I am completely new in VBA or programming. Right now I am developing a macro for a manufacturing site that inputs process data using Excel's User Forms. One of the things I want this macro to do is to automatically create run numbers for each process. The run number syntax we use is as follows:
V1.yy.mm.dd-1
V1.yy.mm.dd-2
V1.yy.mm.dd-3
Ex V1.20.04.29-1
The way I am trying to set up the run number creation is that when I select an item from a ComboBox the part number gets created into a TextBox to later be submitted into the corresponding database. I am not sure how to create a sequence after the Prefix = V1.yy.mm.dd-, I tried to use a CountIf application that would count the number of Prefixes with the same date in the spreadsheet for sequencing, but it seems the function does not work for partial matches. I tried to use the following but I can't get it to work. I am sure there are simpler ways to do this, can you give me a few suggestions? Thanks
This is the code I wrote so far:
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value <> "" Then
Dim Prefix As String
Dim mm, dd, yy As String
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("2- V1 Loading (2)")
Dim s As Long
s = 1 + sh.Application.Count(Application.Match(Prefix, Range("B:B"), 0))
mm = Format(Date, "mm")
dd = Format(Date, "dd")
yy = Format(Date, "yy")
Prefix = "V1." & yy & "." & mm & "." & dd & "-"
v1 = "V1." & yy & "." & mm & "." & dd & "-" & "" & s
Me.TextBox6.Value = v1
End If
Maybe something like this ?
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value <> "" Then
Set sh = ThisWorkbook.Sheets("2- V1 Loading (2)")
oDate = Format(Date, "yy.mm.dd")
oConst = "V1." & oDate & "-"
Range("B1:B10000").Copy Destination:=Range("zz1") 'copy all the item to helper column
Range("zz:zz").Replace What:=oConst, Replacement:="" 'get only the number from all the items with the current date
nextNum = Application.Max(Range("zz:zz")) + 1 'get the next number
MsgBox oConst & CStr(nextNum) 'this line only for checking
Range("zz:zz").ClearContents 'clear the helper column
Me.TextBox6.Value = oConst & CStr(nextNum)
End If
But this assuming that the item number in columns B is only at the same day.
If for example there is a forgotten data from any day before the current day, and this want to be inputted with that day and the next number, it need an input box or maybe a cell in sheet where the value is that day, then it will give the last number of that day.
Suppose the data in column B is something like below:
If the code is run today, it will show V1.20.04.30-4 as the next number. With the same data like above, if the code is run tomorrow, it will give V1.20.05.01-1.
To get the next number from yesterday (29 Apr 2020), the code need more line - which is to know on what day the code must get the next number.
Or this kind of line maybe is shorter:
oConst = "V1." & Format(Date, "yy.mm.dd") & "-"
nextNum = oConst & Application.WorksheetFunction.CountIf(Range("B:B"), "*" & oConst & "*") + 1
MsgBox nextNum
There are a few ways you could go about this but I'd say the easiest would be to put the incrementing run number in a separate cell somewhere on your worksheet (or another one if you want) to reference each time.
For example:
When the data is entered onto your 'database' sheet, write the run value to ThisWorkbook.Sheets("2- V1 Loading (2)").Range("AZ1").
Then in your code check that value like so:
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value <> "" Then
Dim Prefix As String
Dim mm, dd, yy As String
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("2- V1 Loading (2)")
Dim s As Long
s = 1 + sh.Range("AZ1").Value
mm = Format(Date, "mm")
dd = Format(Date, "dd")
yy = Format(Date, "yy")
Prefix = "V1." & yy & "." & mm & "." & dd & "-"
v1 = "V1." & yy & "." & mm & "." & dd & "-" & s
Me.TextBox6.Value = v1
Presuming that the reference numbers are written to column B of the 2- V1 Loading (2) tab then the next number must always be the one found at the bottom of the column + 1. If there is no number for that date than the new sequential number should be 1. The code below implements that method
Function NextRef() As String
' 016
Dim Fun As String
Dim Counter As Integer
Dim Rng As Range
Dim Fnd As Range
Dim Sp() As String
Fun = Format(Date, """V1.""yy.mm.dd")
With ThisWorkbook.Worksheets("2- V1 Loading (2)")
' start in row 2 (row 1 holding column captions)
Set Rng = .Range(.Cells(2, "B"), .Cells(.Rows.Count, "B").End(xlUp))
End With
If Rng.Row > 1 Then ' skip, if the column is empty
' finds the first occurrence of Ref from the bottom
Set Fnd = Rng.Find(What:=Fun, _
After:=Rng.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchDirection:=xlPrevious)
If Not Fnd Is Nothing Then
Sp = Split(Fnd.Value, "-")
If UBound(Sp) Then Counter = Val(Sp(1))
End If
End If
NextRef = Fun & -(Counter + 1)
End Function
You can use the function simply like ComboBox1.Value = NextRef. However when and how to call that line of code is a bit unclear in your design as published. Especially, it's not clear why you would want it in a ComboBox at all, given that the box might also contain other information. Your idea to use the Change event may not work as intended because that event occurs with every letter the user types. I have tested this:-
Private Sub ComboBox1_GotFocus()
' 016
With ComboBox1
If .Value = "" Then .Value = NextRef
End With
End Sub
The next reference number is inserted as soon as you click on the ComboBox. It works but it doesn't make sense. I think now that you have the function that does the work you will find a way to deploy it. Good luck.
I'm trying to simplify a file_split script to a point of self-service in my dept. No one really has any understanding of the language, so I was checking to see if any of this could be further simplified so coworkers don't have to update the code from the editor pane.
for instance, I have things like Basepath to designate where the files will be saved off. How can I change
Dim Basepath As String
Basepath = "C:\Users\File Cuts\"
directory as string
to something like this where a user can select a folder pathway?
Dim Basepath as filedialog
with basepath
.title = "Select save location"
.directory = .selecteditems(1)
end with
and then instances where I have specific columns to reference (target value columns for each new file, naming convention columns, etc...)
as in:
Dim Manager_Name, Login_ID, Leader
Manager_Name = SourceData(i,4)
Login_ID = SourceData(i,5)
Leader = SourceData(i,9)
to be inputted by an input box for column letter like:
Dim column_selection as variant
column_selection = InputBox("Enter Column Letter")
Manager_Name = SourceData(i,column_selection)
There are quite a few references that I'd like to see if I could change so that edits could be made without actually touching the code (the column ranges where variants like name, and login ID will be changing a lot)
rest of code:
Option Explicit
Sub File_Splits()
Dim Wb As Workbook
Dim SourceData, Mgr_Name, Login_Id
Dim i As Long, j As Long, k As Long, a As Long
Dim Destination_Cell As Range
Dim Basepath As String, strNewpath As String, strLeader As String
Basepath = "C:\File Cuts\" '1. paste in file save pathway, keep last \
Set Wb = Workbooks.Open("C:\File_Split_Mgr_Template.xlsx") '2. paste template ws address here
Set Destination_Cell = Wb.Worksheets("Manager Data").Range("A2") '3. Update worksheet name and target cell
With ThisWorkbook.Worksheets("Roster")
SourceData = .Range("I10", .Range("A" & Rows.Count).End(xlUp)) '4. change I10 to your last column letter, dont change the number(keep the 10)
End With
Wb.Activate
Call Speed_Up_Code(True)
For i = 1 To UBound(SourceData)
If SourceData(i, 5) <> Login_Id Then '5. change the 1 to login column #
If i > 9 Then
Destination_Cell.Select
strNewpath = Basepath & strLeader & "\" 'comment this out if folders aren't needed
If Len(Dir(strNewpathD, vbDirectory)) = 0 Then 'comment this out if folders aren't needed
MkDir strNewpath 'comment this out if folders aren't needed
End If 'comment this out if folders aren't needed
Wb.SaveCopyAs strNewpath & _
ValidFileName(Login_Id & "_" & Mgr_Name & "_File Name.xlsx") '6. update file name
End If
With Wb.Worksheets("Manager Data") '7. change to template sheet
.Rows(2 & ":" & .Rows.Count).ClearContents '8. change 2 to row after header(s)--if header isn't in row 1
End With
Mgr_Name = SourceData(i, 4) '9. change 1 to mgr name column
Login_Id = SourceData(i, 5) '10. change 2 to login ID column
strLeader = SourceData(i, 9) '11. change 5 to lvl 3 mgr column
j = 0
End If
a = 0
For k = 1 To UBound(SourceData, 2)
Destination_Cell.Offset(j, a) = SourceData(i, k)
a = a + 1
Next
j = j + 1
Next
If Len(Dir(strNewpath, vbDirectory)) = 0 Then
MkDir strNewpath
End If
SaveCopy Wb, strNewpath, Login_Id, Mgr_Name
Call Speed_Up_Code(False)
End Sub
Public Sub SaveCopy(Wb As Workbook, strNewpath As String, Login_Id, Mgr_Name)
Wb.SaveCopyAs strNewpath & _
ValidFileName(Login_Id & "_" & Mgr_Name & "_File Name.xlsx") '12. update file name
End Sub
Have you considered having a sheet called something like "Configuration" where users write to and your script can read from. Hidden or protected if necessary
For example, list all your configuration description in col A, and the user fills in the value next to in col B, So if A1 contains the text "Manager Name Column [A-Z] =" the user enters the value "D" or 4 in cell B1. The script become Mgr_Name = SourceData(i, wsConfig.range("B1")). I guess you could add validation to their entries.
Layout the sheet like a form in logical groups and highlight where the entry cells are. In a case like entering column names I would put them horizontal with the descripting above and entry cell below, that seems more natural. Protect all the cells except the highlighted ones.
I have a folder with files, all named by date. I have the file name (date) that I'm looking for, in cell E2. The cell has already been formatted so that it's in the same format as the file names. Here's what I have so far:
Sub Step2Importsheet()
Sheets.Add Type:= _
"E:\MyFolder\Manipulated Data\Test\" & Range("E2").Text & ".csv"
End Sub
This code works great if the date in cell E2 exists as a file in the folder.
Now here's my problem: In some cases, I have a date listed in E2 that does not exist as a file in the folder. I want to expand the code so that if it doesn't exist, it looks for the next sequential date until it finds a file. (In most cases this will be one or two dates after the date in E2 but it might go as far as five days out. It will never hit an indefinite loop).
Appreciate any and all help!
Something like this should work for you:
Sub LookForFile()
Dim sBaseFolder As String
Dim objFSO As Object
Dim datFileName As Date
Set objFSO = CreateObject("FileSystemObject")
sBaseFolder = "E:\MyFolder\Manipulated Data\Test\"
' Initalize date
datFileName = CDate(Range("E2"))
Do While Not objFSO.FileExists(sBaseFolder & GetFileNameFromDate(datFileName) & ".csv")
datFileName = DateAdd("d", 1, datFileName)
' Maybe place a limit here in case file doesn't exist
Loop
' datFileName should now contain the date of a matching file
End Sub
Function GetFileNameFromDate(ByVal p_date As Date)
' Returns YY-MM-DD format
GetFileNameFromDate = Year(p_date) & "-" & Right("0" & Month(p_date), 2) & "-" & Right("0" & Day(p_date), 2)
End Function
The GetFileNameFromDate function lets you specify the file name format since I imagine it's not a direct date but probably a string with the slashes removed.
Thanks everyone! The code below works well. I had to use Range instead of Date because I had to convert it to Text for it to be able to work as a file name.
Dim newdate As Range
Set newdate = Range("E2")
Do Until Dir("E:\MyFolder\Manipulated Data\Test\" & newdate.Text & ".csv") <> vbNullString
newdate = newdate + 1
Loop
Sheets.Add Type:="E:\MyFolder\Manipulated Data\Test\" & newdate.Text & ".csv"