I searched for an answer to this question, but it seems like the only ways that people have answered it are using Excel functions. I have a file in Excel that I load in to a text file, but new data comes out every week. I need to replace the Market names in this first column with their respective tickers, which are in this separate worksheet, but in the same Excel file.
For example, I want all 'CANADIAN DOLLAR - CHICAGO MERCANTILE EXCHANGE' cells to be replaced with 'CAD', all 'SWISS FRANC - CHICAGO MERCANTILE EXCHANGE' cells to be replaced with 'SWF', etc.
I would prefer if the names remained the same in the Excel file and were only changed when I transferred them to the text file. However, that's not essential if it's harder to do.
For reference, here's the code I'm using to write to the text file:
Sub getData1()
On Error GoTo ErrHandler:
''Finding Row Information
Dim Ticker As String
Dim rCount As Integer, i As Integer, j As Integer, rcCount As Integer, rowStr As String
rCount = Application.CountA([RDRows])
rcCount = Application.CountA([RDCols])
Myfile = "H:\wkoorbusch\Desktop\" & "CFTC_Fin_Data.txt"
Dim fnum As Integer
fnum = FreeFile
Open Myfile For Output As fnum
For i = 1 To rCount
For j = 1 To rcCount
rowStr = [Start].Offset(i, 0).Value & "," & [Start].Offset(0, j).Value _
& "," & Format([Start].Offset(i, 2).Value, _
"mm/dd/yyyy") & "," & [Start].Offset(i, j).Value
Print #fnum, rowStr
Next j
Next i
Close fnum
Exit Sub
ErrHandler:
Close fnum
End Sub
Thanks in advance for any and all help.
Place the Text and its replacement in 2 colums of your spreadsheet, then use
On Error Resume Next
Application.WorksheetFunction.VLookup(MyText,range("Sheet1!A1:B300"),2,False)
If Err.Number=1004 then msgbox "Value " & MyText & " not found"
to return the replacement text.
A trappable err.Number of 1004 is returned when the lookup value is not found.
(functionally equivalent to VLOOKUP as a spreadsheet formula)
Related
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
I have a file which is modified through VBA.
It is concatenating three columns in the sheet to create a name.
However, another information needs to be concatenated to create the new data.
The data needs to be created by deducing something from data in another workbook.
In a scpecific column, with always the same name (but whose location can change, however in the sheet), the macro needs to look for a specific information. There can be four possibilities.
Once this possibility is identified, once the term is matched from either of these four, the VBA should increment the number in the end of the term in the workbook needs to be incremented.
The structure of is as follows in the first workbook:
Nip Nup Noupx
For "Noup" there are four cases : Noupx, Noupy, Noupu, Noupa
The VBA concatentes : NipNupNoupa
(or possibly NipNupNoupx, NipNupNoupu...)
Then the VBA should go in the other workbook, look for either the term "Noupa", "Noupu", "Noupx", "Noupy".
For each of these the specific number comming after "Noupa" (or the other) should be identified and should increment it by adding "+1".
Thus the result would be:
Noupa002 (resulting from the identification of Noupa001)
Noupu034 (resulting from the identificiation of Noupu033)
For the time being, I have the following VBA code, I do not know how to look for data in another workbook and increment it.
Sub TralaNome()
Const q = """"
' get source data table from sheet 1
With ThisWorkbook.Sheets(1).Cells(1, 1).CurrentRegion
' check if data exists
If .Rows.Count < 2 Or .Columns.Count < 2 Then
MsgBox "No data table"
Exit Sub
End If
' retrieve headers name and column numbers dictionary
Dim headers As Dictionary
Set headers = New Dictionary
Dim headCell
For Each headCell In .Rows(1).Cells
headers(headCell.Value) = headers.Count + 1
Next
' check mandatory headers
For Each headCell In Array(("Costumer", "ID", "Zone“, "Product Quali", "Spec A", "Spec B", "Spec_C", "Spec_D", "Spec_1", " Spec_2", " Spec_3", " Spec_4", " Spec_5", " Spec_6", " Spec_7", "Chiavetta", "Tipo_di _prodotto", "Unicorno_Cioccolato", “cacao tree“)
If Not headers.Exists(headCell) Then
MsgBox "Header '" & headCell & "' doesn't exists"
Exit Sub
End If
Next
Dim data
' retrieve table data
data = .Resize(.Rows.Count - 1).Offset(1).Value
End With
' process each row in table data
Dim result As Dictionary
Set result = New Dictionary
Dim i
For i = 1 To UBound(data, 1)
MsgBox "Empty row"
Exit For
result(result.Count) = _
q & "ID " & data(i, headers("ID ")) & _
q & " Tipo_di _prodotto " & data(i, headers("Tipo_di _prodotto")) & _
q & " cacao tree " & data(i, headers("Nupu")) & _
q
End Select
Next
' output result data to sheet 2
If result.Count = 0 Then
MsgBox "No result data for output"
Exit Sub
End If
With ThisWorkbook.Sheets(2)
.Cells.Delete
.Cells(1, 1).Resize(result.Count).Value = _
WorksheetFunction.Transpose(result.Items())
End With
MsgBox "Completed"
End Sub
The columns are grouped through this macro, but I need to now look in the other worksheet, increment the various Noupu, Noupy etc etc etc...
I think that a VBA of that sort should be used to add an incremented value :
Function GetLastRowWithData(WorksSheetNoupa As Worksheet, Optional NoupaLastCol As Long) As Long
Dim lCol, lRow, lMaxRow As Long
If NoupaLastCol = 0 Then
NoupaLastCol = wsSheet.Columns.Count
End If
lMaxRow = 0
For lCol = NoupaLastCol To 1 Step -1
lRow = wsSheet.Cells(wsSheet.Rows.Count, lCol).End(xlUp).Row
If lRow > lMaxRow Then
lMaxRow = lRow
End If
Next
GetLastRowWithData = lMaxRow
End Function
(sorry, this probably should be a comment but I don't have enough reputation as yet).
However even without checking through your code in detail, I'm seeing an exit for in the middle of a for loop without an If to avoid it in certain conditions. Presumably this means that whatever's written below that line in the loop, never gets done - nor is the loop any good for anything but the first instance. (it's the loop that's annotated 'process each row in table data)
Have you tried running this step by step? (go into the VBEditor with a test dataset open, and hit F8 or the 'step into' button in debug toolbar )
I am trying to use the code below, however I don't understand why it is printing out a blank message box? Additionally, there is only one for each day, and it is saying there is 2 files?
How do I print these back effectively, second, how do I then use that to open the sheet?
The files are written as samadmin15112018_??????.csv Where the question marks are a time stamp which I don't know.
Sub runFA()
Const yourfilepath = "R:\samsdrive\sam\test\"
Dim s As String
Dim x As Integer
Dim v() As String
s = Dir(yourfilepath & "samadmin" & format(Sheets("Name").Range("C3"), "yyyymmdd") & "_*.csv")
v = Split(vbNullString)
Do Until s = ""
x = x + 1
ReDim Preserve v(x + 1)
s = Dir()
Loop
If UBound(v) > 0 Then
MsgBox "There are " & UBound(v) & " workbooks", vbOKOnly
MsgBox v(x + 1)
Else
If v(0) <> "" Then Workbooks.Open (yourfilepath & v(0))
MsgBox ("There are 0 ")
End If
End Sub
Fixing the previous answer...
You were getting an empty element because the original code resized the array for the first element, which meant that v(0) was always going to be vbNullString. With string arrays, you can take advantage of the Split function's behavior of returning an array with a UBound of -1 and an LBound of 0 if you're going to add elements to it dynamically:
Sub runFA()
Const targetPath = "R:\samsdrive\sam\test\"
Dim located() As String
located = Split(vbNullString)
Dim result As String
result = Dir$(targetPath & "samadmin" & Format$(Sheets("Name").Range("C3"), "yyyymmdd") & "_*.csv")
Do Until result = vbNullString
ReDim Preserve located(UBound(located) + 1)
located(UBound(located)) = result
result = Dir$()
Loop
If UBound(located) <> 0 Then
MsgBox "There are " & (UBound(located) + 1) & " workbooks", vbOKOnly
Else
Workbooks.Open targetPath & result
End If
End Sub
A couple other things to note
I changed the variable names from single letter identifiers to something a little easier to read and understand.
The indentation is now consistant.
It uses the string typed functions for Dir and Format.
You don't need to track the count of results with x at all.
If you only have one element in the results array, you can simply use result - there isn't any reason to index back into the array.
I have some number in a column in excel like this:
201
202
208-1
210
when I sort this column, sorted column is like below:
201
202
210
208-1
How do I sort this column? I want the sorted column becomes like this:
201
202
208-1
210
or
210
208-1
202
201
One option is a hidden column, say if your values listed above were in A2:A5, insert a column to the right and in B2 enter the formula below and copy this down to the other B cells:
=IFERROR(VALUE(LEFT(A2,FIND("-",A2)-1)),VALUE(A2))
or alternative suggested by #Gary'sStudent that handles values after the hyphen as well by converting to decimals:
=IFERROR(VALUE(SUBSTITUTE(A2,"-",".")),VALUE(A2))
This strips out the number up to the first hyphen. Select all of the values in the two columns, select sort and then sort by columnB. you can then right click on column B and select hide.
If you do not want to use hidden columns then I think your only option would be to write some VBA to do a custom sort procedure. You would then also need a way of triggering this such as a control in the spreadsheet or just a keyboard shortcut.
UPDATE
I have had a go at the VBA procedure, it was not as straight forward as I expected so it may be that there is an easier way to do this.
The basic steps I went through are to prompt the user for a cell range (you just have to select the cells when prompted), store the values to an array of strings, create an equivalent numeric array where the hyphens are replaced by decimal points, sort the numeric array and then loop through the initial range pasting in the values in order.
I was surprised to find out that VBA does not have a built in method for sorting an array, but found some code that could be used here. This creates a temp worksheet and uses the worksheet function, there is also code there for a pure VBA solution but it's pretty lengthy.
To create the VBA procedure you will need to open the VBA editor with alt F11 and create a new module then paste the code below into a module (create a new module - right click on modules on right and insert) then paste in the code below.
The procedure that you need to call is sort_with-hyphens.
You will need to create a control or create a keyboard short cut to trigger this. For either you will need to enable the developer ribbon tab through File>Options. For the control do developer>control>button and right click to assign a macro. For the keyboard short cut developer>Macros select the VBA procedure name from the list of macros and select options.
Sub sort_with_hyphens()
On Error GoTo sort_with_hyphens_err
Dim vRange As Range
Dim vCell As Variant
Dim vStrArray(), vNumArray()
Dim i As Long, vStart As Long, vEnd As Long
Dim vStep As String: vStep = "Initialising values"
' prompt user to specify range
Set vRange = Application.InputBox("Select a range to be sorted", _
"Obtain Range Object", _
Type:=8)
vStrArray = vRange.Value
vStart = LBound(vStrArray)
vEnd = UBound(vStrArray)
ReDim vNumArray(vStart To vEnd)
vStep = "Populating Numeric Array"
' loop through array copying strings with hyphen to decimal equivalent
For i = vStart To vEnd
vNumArray(i) = Val(Replace(vStrArray(i, 1), "-", "."))
Debug.Print i, vNumArray(i)
Next i
' sort numeric array
vStep = "Sorting Numeric Array"
SortViaWorksheet vNumArray
' write out sorted values
vStep = "Writing out Sorted Values"
For i = vStart To vEnd
' convert back to string and switch periods back to hyphens
vRange.Cells(i, 1).Value = Replace(CStr(vNumArray(i)), ".", "-")
Next
sort_with_hyphens_exit:
Exit Sub
sort_with_hyphens_err:
If vStep = "Writing out Sorted Values" Then
MsgBox ("An error has occurred, the original values will " & _
"be restored. Error in Step: " & vStep & vbCrLf & _
"Error Details:" & vbCrLf & err.Number & " - " & _
err.Description)
For i = vStart To vEnd
' replace with original value incase of error
vRange.Cells(i, 1).Value = vStrArray(i)
Next
Else
MsgBox ("An error has occurred in Step: " & vStep & vbCrLf & _
"Aborting sort procedure." & vbCrLf & _
"Error Details:" & vbCrLf & err.Number & " - " & _
err.Description)
End If
End Sub
Sub SortViaWorksheet(pArray)
Dim WS As Worksheet ' temporary worksheet
Dim R As Range
Dim N As Long
Application.ScreenUpdating = False
' create a new sheet
Set WS = ThisWorkbook.Worksheets.Add
' put the array values on the worksheet
Set R = WS.Range("A1").Resize(UBound(pArray) - LBound(pArray) + 1, 1)
R = Application.Transpose(pArray)
' sort the range
R.Sort key1:=R, order1:=xlAscending, MatchCase:=False
' load the worksheet values back into the array
For N = 1 To R.Rows.Count
pArray(N) = R(N, 1)
Next N
' delete the temporary sheet
Application.DisplayAlerts = False
WS.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
' test/debug/confirmation
Debug.Print vbCrLf & "Sorted Array:" & vbCrLf & "------------"
For N = LBound(pArray) To UBound(pArray)
Debug.Print N, pArray(N)
Next N
End Sub
Let me know if you have any questions.
I am writing a custom sorting procedure for my Excel spreadsheet that has at least 3 worksheets. On first position I put the worksheet called "Summary", on second goes "Data" and the rest are worksheets whose names are dates ex "17.03.2011", "20.03.2011" etc. Those need to be sorted chronologically.
Here is what I have so far, the script stops with an "Object Required" error on line with the DateDiff() and I have no idea why:
After correcting the code below I am still having trouble in making the thing sort in the right order. Can anyone suggest a way to compare and move around the sheets?
Public Sub ssort()
sSummary.Move before:=Worksheets.Item(1)
sData.Move after:=sSummary
Dim i, n As Integer
Dim diff As Long
Dim current, other As Worksheet
For i = 1 To Worksheets.Count
Set current = Worksheets.Item(i)
If current.Name <> sData.Name And current.Name <> sSummary.Name Then
For n = i + 1 To Worksheets.Count
Set other = Worksheets.Item(n)
diff = DateDiff(DateInterval.day, Format(current.Name, "dd.mm.yyyy"), Format(other.Name, "dd.mm.yyyy"))
If diff > 0 Then
current.Move before:=other
Debug.Print "Moving " & current.Name & " before " & other.Name
ElseIf diff < 0 Then
current.Move after:=other
Debug.Print "Moving " & current.Name & " after " & other.Name
End If
Next n
End If
Next i
End Sub
I think I either don't understand DateDiff() or Format(), could anyone please shed some light on this?
After modifying code from an online example here http://www.vbaexpress.com/kb/getarticle.php?kb_id=72 to use the datediff for comparison, I came up with this solution which works as intended:
Sub sort2()
sSummary.Move before:=Worksheets.Item(1)
sData.Move after:=sSummary
Dim n As Integer
Dim M As Integer
Dim dsEnd, lowest As Integer
Dim dCurrent() As String
Dim dOther() As String
Dim diff As Long
dsStart = 3
dsEnd = Worksheets.Count
For M = dsStart To dsEnd
For n = M To dsEnd
If Worksheets(n).Name <> "Summary" And Worksheets(n).Name <> "Data" And Worksheets(M).Name <> "Summary" And Worksheets(M).Name <> "Data" Then
dCurrent = Split(CStr(Worksheets(n).Name), ".")
dOther = Split(CStr(Worksheets(M).Name), ".")
diff = DateDiff("d", DateSerial(dCurrent(2), dCurrent(1), dCurrent(0)), DateSerial(dOther(2), dOther(1), dOther(0)))
If diff > 0 Then
Worksheets(n).Move before:=Worksheets(M)
End If
End If
Next n
Next M
End Sub
The DateDiff function requires the two date arguments to be of Variant (Date) type. Instead you're giving it two String arguments, which is what the Format function returns.
You need to convert each of the Strings to Variant (Date). This can be done like this:
strDate = current.Name ' String: "20.03.2011"
aintDateElements = Split(strDate, ".") ' Array: {2001, 03, 20}
varDate = DateSerial(aintDateElements(2), aintDateElements(1),
aintDateElements(0)) ' Variant (Date)
There are other ways of doing this conversion, but I find that this is the way that least often gives unexpected results!
If you took this code off of the web, be aware that DateInterval isn't a native Excel object or a VBA object, it's a .Net object. You could just substitute "d" for "DateInterval.day".
diff = DateDiff("d", Format(current.Name, "dd.mm.yyyy"), _
Format(other.Name, "dd.mm.yyyy"))
If you're getting error messages in Format/Datediff calls, try split them into separated statements. You'll see where the problem lies.
Example:
dtStart = CDate(Format(current.Name, "dd.mm.yyyy"))
dtEnd = CDate(Format(other.Name, "dd.mm.yyyy"))
diff = DateDiff("d", dtStart, dtEnd)