Not the best at VBA but I will give some context to help explain this probably stupid question.
The place I work for has a terrible system so we tend to do things our own way and use the system as little as possible.
We wanted to be able to take direct debits from customers as and when we need to and to do this we needed to create a 'BACS Standard 18' file to upload to the bank in order to collect the direct debits. The file requires there to be specific information about the transaction and it has to be displayed in a very specific way in notepad(txt).
I managed to create an Excel file that our finance team can use in order to create the file but when the file is created the typing cursor is always found to be a couple of lines under the exported text.
I need the text to be exported and the typing cursor to be at the end of the last line of the text, or a least not underneath. If it is under it, the bank will see that as a blank line and not accept the file. The number of lines in the file will always be different as well.
I have attached an example of the file in a screenshot. The highlighted part is what the file should include but as you can see the typing cursor is two lines lower.
Can someone please help with this and explain where I have gone wrong.
Thank you.
exportedfile
Below is the [vba] used to build the file and export the data from excel to notepad:
Sub Build_BACS()
LastRow = (Worksheets("Input").Range("Q2"))
'Header
ActiveSheet.Range("A1").Value = "=""VOL1""&Home!D5&"" ""&Home!D2&"" ""&""1"""
ActiveSheet.Range("A2").Value = "=""HDR1A""&Home!D2&""S""&"" ""&Home!D5&""00010001 ""&Home!D8&"" ""&Home!E8&"" 000000 """
ActiveSheet.Range("A3").Value = "=""HDR2F02000""&Home!B11&"" 00 """
ActiveSheet.Range("A4").Value = "=""UHL1 ""&Home!D8&""999999 000000001 DAILY 001 """
'Middle
ActiveSheet.Range("A5").Value = "=CONCAT(Input!C2,Input!D2,Input!K2,Input!G2,Input!H2,"" "",Input!L2,Input!M2,"" "",Input!N2,Input!O2)"
On Error Resume Next
Range("A5").AutoFill Destination:=Range("A5:A" & LastRow + 4), Type:=xlFillDefault
'Footer
If Sheets("Home").Range("A2").Value = "TMR" Or Sheets("Home").Range("A2").Value = "TMRF" Or Sheets("Home").Range("A2").Value = "TMREA" Then
Sheets("Output").Range("A" & LastRow + 5).Value = "=TEXT(Home!C2,""000000"")&TEXT(Home!B2,""00000000"")&""099""&TEXT(Home!C2,""000000"")&TEXT(Home!B2,""00000000"")&"" ""&TEXT(Input!P2,""00000000000"")&""The Mailing Room CONTRA TMR """
ElseIf Sheets("Home").Range("A2").Value = "DPS" Then
Sheets("Output").Range("A" & LastRow + 5).Value = "=TEXT(Home!C2,""000000"")&TEXT(Home!B2,""00000000"")&""099""&TEXT(Home!C2,""000000"")&TEXT(Home!B2,""00000000"")&"" ""&TEXT(Input!P2,""00000000000"")&""DPS CONTRA TMR """
End If
ActiveSheet.Range("A" & LastRow + 6).Value = "=""EOF1""&MID(A2,5,76)"
ActiveSheet.Range("A" & LastRow + 7).Value = "=""EOF2""&MID(A3,5,76)"
ActiveSheet.Range("A" & LastRow + 8).Value = "=""UTL1""&TEXT(Input!P2,""0000000000000"")&TEXT(Input!P2,""0000000000000"")&""0000001""&TEXT(Input!Q2,""0000000"")&"" """
'Export
Dim c As Range
Dim r As Range
Dim output As String
For Each r In Range("A1:A" & LastRow + 8).Rows
For Each c In r.Cells
output = output & c.Value
Next c
output = output & vbNewLine
Next r
Open ThisWorkbook.Path & "\" & ([Indirect("Home!B13")]) & ".txt" For Output As #1
Print #1, output
Close
InputBox "Noice." & Chr(13) & "Your file is just in here", "File Path", "Z:\My Documents\Orrin Lesiw\Direct Debit\Convert File"
End Sub
Adding ; to Print suppressed the vbNewLine. However output = output & vbNewLine will always add a newline so either add to front for lines 2 onwards like
Sub out2()
Dim c As Range
Dim r As Range
Dim output As String
For Each r In Range("A1:A" & LastRow + 8).Rows
If r.Row > 1 Then output = output & vbNewLine
For Each c In r.Cells
output = output & c.Value
Next c
Next r
Open ThisWorkbook.Path & "\" & ([Indirect("Home!B13")]) & ".txt" For Output As #1
Print #1, output;
Close
End Sub
or transpose the range into an array and use Join
' Export
Dim ar
ar = Application.Transpose(Range("A1:A" & LastRow + 8))
Open ThisWorkbook.Path & "\" & ([Indirect("Home!B13")]) & ".txt" For Output As #1
Print #1, Join(ar, vbNewLine);
Close
Related
I'm having trouble with CSV treatment in VBA:
I've got 1 input CSV file that need to be exported in 2 different CSV files, renaming certain columns and deleting others
Agents using the macro can't change local setting
I've got this code:
Dim fileBt As String
fileBt = SequoiaPath & Left(Filename, InStr(Filename, ".") - 1) & "/BT/NipBtSearch.csv"
FileCopy Path & Filename, fileBt
Dim Wbt As Excel.Workbook
Workbooks.OpenText Filename:=fileBt, DataType:=xlDelimited, Semicolon:=True
Set Wbt = ActiveWorkbook
Debug.Print Wbt.Sheets(1).Range("A1").Value
Wbt.Close True
Don't mind it's optimization, I've been testing for hours now and it's kind of a mess.
PS: The computer are set to French, so I'm guessing my default separator is ,.
Output:
NipBtSearch.csv is well formed, using correctly the semi-colons separator.
Debug.Print Wbt.Sheets(1).Range("A1").Value gives me the whole line
N° Dossier;Intitulé du dossier;N° Accès produit;Objet de l'accès produit;Domaine;Date d'initialisation;Heure d'initialisation...
If I try to change the value of A1, it breaks everything in my new CSV, I'm guessing because line 1 now has only one column.
So, as I was saying, I'm really struggling with this, I feel like I'm missing how to treat my CSV as a workbook with this range issue
You need to custom the output concatenating the values with your delimiter semicolon.
I made a fake origin source CSV dataset like this called csvfile.csv
Sub tets()
Dim WBsource As Workbook
Dim i As Long, j As Long, LastCol As Long
Dim FileSource As String, NewFileDestiny As String
Dim FullData As Variant
FileSource = "C:\Temp\csvfile.csv"
NewFileDestiny = "C:\Temp\newcsvfile.csv"
Set WBsource = Application.Workbooks.Open(FileSource, , , , , , , , ";", , , , , True)
With WBsource.ActiveSheet
'<---do whatever operations you do with data--->
.Cells.Replace "Value", "DummyText"
'<---end operations you do with data--->
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
FullData = .Range("A1").CurrentRegion.Value 'take all data into array
.Range("A1").CurrentRegion.Clear 'delete everything
'contatenate everything into Column A delimited by semicolon
For i = 1 To UBound(FullData)
'loop trough columns for each row of data and concatenate
For j = 1 To LastCol
.Range("A" & i).Value = .Range("A" & i).Value & FullData(i, j) & ";"
Next j
'after concatenate all, delete last semicolon
.Range("A" & i).Value = Left(.Range("A" & i).Value, Len(.Range("A" & i).Value) - 1)
Next i
End With
Erase FullData 'delete to clear memory
'output to NEW csv to not alter original file!!!
WBsource.SaveAs NewFileDestiny, xlCSV
'close file
WBsource.Close False 'we already saved before, no need to redo
End Sub
After executing code I get a new CSV file like this:
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've got an excel doc with 2 tabs. A data tab and a template tab. The data tab contains data in chunks equally spaced apart starting in row 52 (for this situation there's only three chunks). I want my code to copy some cells (the ones in gold) and paste it into the template tab. Then duplicate the template tab in another workbook to be saved and closed. Then it would go back to the original workbook and do the next chunk of data in the data tab till the end of all possible data (which will vary week over week, so like next week there could be 10 chunks).
Without the 'make new workbook and save' part of the code I can see it properly copy-pasting/cycling through to the end on my Template tab. So if it's plain like this, the data on the Template tab when done it's exactly the same as the last data set in the Data tab (aka the third chunk of the three total chunks of data with France + Nice). But when I add the new workbook+save feature it will properly do the 1st data chunk but then rapidly spirals into generating a bunch of empty excel docs that I have to ESC out of or will will never stop making them.
Dim i As Long, lastRow As Long
Set fnc = Sheets("France")
Set st = Sheets("Template")
lastRow = fnc.Cells(Rows.Count, "B").End(xlUp).Row
For i = 52 To lastRow
st.Range("B30").Value = fnc.Range("B" & i).Value
st.Range("C30").Value = fnc.Range("C" & i).Value
st.Range("D33").Value = fnc.Range("D" & i + 3).Value
st.Range("E33").Value = fnc.Range("E" & i + 3).Value
st.Range("F33").Value = fnc.Range("F" & i + 3).Value
st.Range("G33").Value = fnc.Range("G" & i + 3).Value
st.Range("H33").Value = fnc.Range("H" & i + 3).Value
Sheets("Template").Select
Sheets("Template").Copy
Sheets("Template").Name = "True Template"
If Dir("C:\Users\Edamame\Desktop\True Template", vbDirectory) = "" Then
MkDir ("C:\Users\Edamame\Desktop\True Template")
End If
ChDir ("C:\Users\Edamame\Desktop\True Template") ' Makes it save to the folder
Filename = "FW" & Format(Date, "ww") & "_" & Range("D30") & "_" & Range("B30") & "_True Template_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close False
Windows("Wine.xlsb").Activate
Next i
As per my comment:
Seems to me you are using empty cells to populate B30 and C30 if you go from 52 to lastRow. Try to include a Step 10 and check if that would work.
For i = 52 To lastRow Step 10
I've just created a brand new macro. Took function down below from internet (all credits goes to trumpexcel.com), code down below
Function CONCATENATEMULTIPLE(Ref As Range, Separator As String) As String
Dim Cell As Range
Dim Result As String
For Each Cell In Ref
Result = Result & Cell.Value & Separator
Next Cell
CONCATENATEMULTIPLE = Left(Result, Len(Result) - 1)
End Function
Then I proceed to extract data from various columns and into the one (my table is 20 rows x 10 columns)
Sub conact_data()
Dim i As Integer
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "M").Value = Cells(i, "A").Value & " " & _
Cells(i, "B").Value & " / " & Cells(i, "D").Value & "; "
Next i
End Sub
Thanks to that I've got combined data from column A, B and D, so its 20 rows. All I want to do now is to concatenate data from M2:M21 using CONCATENATEMULTIPLE function therefore I try various approach (I want this huge line in P2 cell) like :
Cells(2, 16).Value = CONCATENATEMULTIPLE (M2:M21, " ")
or
Range("P2") = "CONCATENATEMULTIPLE (M2:M21, " ")"
I don't really know how to apply that
Secondly, I'd like withdraw the Cells(i, "B").Value as percentage. Can I do that in one line like Cells(i, "B").NumberFormat="0.00%".Value (which is not working for me obviously) else I need to copy column B into another column with number format and then combine the new column, properly formatted instead of column B?
Thanks in advance
Percent format: Range("B" & i).NumberFormat = "0.00%"
CONCATENATEMULTIPLE
In VBA, CHR(32) = " "
In Excel, CHAR(32) = " "
With that being said...
'Value
Range("P2").Value = CONCATENATEMULTIPLE(Range("M2:M21"), CHR(32))
'Formula
Range("P2").Formula = "=CONCATENATEMULTIPLE(M2:M21, CHAR(32))"
You should really qualify all of your ranges with a worksheet
Say your workbook has 10 sheets. When you say Range("P2"), how do we (VBE) know what sheet you mean? Objects need to be properly qualified. Sometimes this is not a huge issue, but when you are working across multiple sheets, not qualifying ranges can lead to some unexpected results.
You can qualify with a worksheet a few ways.
Directly: ThisWorkbook.Sheets("Sheet1").Range("P2").Copy
Or use a variable like so
Dim ws as Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Range("P2").Copy
Now there is no room for ambiguity (potential errors) as to the exact location of Range("P2")
First of all, remove your ConcatenateMultiple() code, and instead use Excel worksheet function CONCAT(), which takes a range and a delimiter as parameters.
Here is how you can handle the percentage issue and supply a default for non-numeric items. I've also cleaned up the way you reference your data range.
Sub concat_data()
Dim rngRow As Range, vResult As Variant
Const DEFAULT = 0 'Can also be set to a text value, eg. "Missing"
For Each rngRow In [A2].CurrentRegion.Rows
If IsNumeric(rngRow.Cells(, 4)) Then vResult = rngRow.Cells(, 4) * 100 & "%" Else vResult = DEFAULT
Range("M" & rngRow.Row) = rngRow.Cells(, 1) & rngRow.Cells(, 2) & "/" & vResult & ";"
Next
[M2].End(xlDown).Offset(1).Formula = "=CONCAT(M2:M" & [M2].End(xlDown).Row & ",TRUE,"" "")"
End Sub
I'm not a fan of hard-coding range references, like the [A2] or Range("M"), but will leave that for another time.
I have a macro that moves some data around in different spreadsheets and I have been trying to figure out why my Debug.Print is not printing the long data. It prints the string but wont print the long.
The below code does not produce an error message and the data is moved as I would expect it to be however when I try to use a print statement to print to the Immediate window all I get is the string portion of the print.
I have tried to convert to string using CStr() on my long just in case it was a problem with concatenating non-string with string with no change in results. I have tried just printing the long by itself and all it prints is an empty line to the Immediate window.
My question is this:
Is there a reason for my code to not print the long?
I know the results of my MACRO do exactly what I need them to do by manually verify each step with breakpoints but why is Debug.Print not printing the long?
Example results from Debug.Print
Last Row for G90_CTR_WS:
Last Row for L90_CTR_WS:
Last Row for BU_WB:
Last Row for rng1:
Last Row for rng2:
Code:
On Error GoTo 0
lr_counter = inv_wb.Worksheets(7).Cells(Rows.Count, "A").End(xlUp).Row
Set rng1 = inv_wb.Worksheets(7).Range("A2:G" & lr_counter)
Debug.Print ("Last Row for G90_CTR_WS: " & lr__counter)
lr_counter = inv_wb.Worksheets(6).Cells(Rows.Count, "A").End(xlUp).Row
rng1.Cut Destination:=inv_wb.Worksheets(6).Range("A" & lr_counter + 1)
Debug.Print ("Last Row for L90_CTR_WS: " & lr__counter)
check_for_file = Dir(workbook_directory & "\*backup*")
Set bu_wb = Workbooks.Open(workbook_directory & "\" & check_for_file)
lr_counter = bu_wb.Worksheets(1).Cells(Rows.Count, "B").End(xlUp).Row
Set rng1 = bu_wb.Worksheets(1).Range("B2:B" & lr_counter)
Debug.Print ("Last Row for BU_WB: " & lr__counter)
bu_wb.Close SaveChanges:=False
lr_counter = inv_wb.Worksheets(6).Cells(Rows.Count, "A").End(xlUp).Row
Set rng2 = inv_wb.Worksheets(6).Range("A2:A" & lr_counter)
Debug.Print ("Last Row for rng1: " & lr__counter)
check_for_file = Dir(workbook_directory & "\*vehicle*list*")
Set vl_wb = Workbooks.Open(workbook_directory & "\" & check_for_file)
lr_counter = vl_wb.Worksheets(1).Cells(Rows.Count, "I").End(xlUp).Row
Set rng3 = vl_wb.Worksheets(1).Range("I2:I" & lr_counter)
Debug.Print ("Last Row for rng2: " & lr__counter)
Put Option Explicit and see where the code explodes. - Option Explicit
A way to have automatically written Option Explicit is to select "Require Variable Declaration" in the VBEditor>Tools>Options:
In general, I guess it is here:
lr_counter = inv_wb.Worksheets(7).Cells(Rows.Count, "A").End(xlUp).Row
Set rng1 = inv_wb.Worksheets(7).Range("A2:G" & lr_counter)
Debug.Print ("Last Row for G90_CTR_WS: " & lr__counter)
lr__counter is with 2 _ and is declared with 1.