I'm in the process of writting a macro for collecting debris. At each location, a series of tasks will be performed to recover the debris. The majority of these locations will require the same activities so im assuming they are all the same and the user can modify them as required after the macro is complete. Below is the current code:
Public Function additional_Lines(ByVal target_ID)
ActiveCell.offset(1, 0).Select
Dim offset As String
offset = " "
Dim additional_Text As Variant
additional_Text = Array(offset & "Relocate to " & target_ID, offset & "Recover " & target_ID, offset & "Recover basket")
For i = 0 To UBound(additional_Text)
ActiveCell.Value = additional_Text(i)
ActiveCell.offset(1, 0).Select
Next i
End Function
This generates the following output
OSP-040
Relocate to OSP-040
Recover OSP-040
Recover basket
ZDUN-THI-004
Relocate to ZDUN-THI-004
Recover ZDUN-THI-004
Recover basket
OSP-046
Relocate to OSP-046
Recover OSP-046
Recover basket
OSP-056
Relocate to OSP-056
Where OSP-056, OSP-046, ZDUN-THI-004, OSP-004 are the debris locations.
I'm wanting to allow the user to type in the text they would like to insert between the debris locations in one of the sheets ie:
Relocate to (Debris ID Number)
Recover (Debris ID Number)
Where Debris ID Number is stored in an array. Is it possible to read the 2 string above and then replace the (Debris ID Number) with a variable so i can update it from the array of debris IDs?
There is a replace function which can search a string for a specified string, and once it finds it, can replace it. Rather than replace it with a static string, i have referenced an array of the debris IDs.
For y = 1 To UBound(additional_Lines)
new_additional_Lines(y) = Replace(additional_Lines(y, 1), ID, " " & target_ID & " ")
Next y
Thanks again for everyones help.
Related
I've written an export (Access to Excel) function in an application that works in ranges.
The user has 4 RadioButtons: A-F, G-M, N-R and S-Z.
Let's say the user has selected rbtnAF, which will load all customers into the grid where the Customer_Code field starts with an A, B, C, D, E or F.
The code to load in the data is as follows:
Dim strFields As String = "[Customer_Addresses].[Cust_Code], [Customers].[Customer_Name], [Customer_Addresses].[Contact_Code], [Customer_Addresses].[Contact_Name], " & _
"[Customer_Addresses].[Contact_Type], [Customer_Addresses].[Add1], [Customer_Addresses].[Add2], [Customer_Addresses].[Add3], [Customer_Addresses].[Add4], " & _
"[Customer_Addresses].[Add5], [Customer_Addresses].[Postcode], [Customer_Addresses].[Country], [Customer_Addresses].[Telephone], [Customer_Addresses].[Fax], " & _
"[Customer_Addresses].[Email], [Customer_Addresses].[Mobile_Phone], [Customers].[Customer_Category], [Customers].[Average_Payment_Terms], " & _
"[Customers].[Notes], [Customers].[salesRep], [Customers].[hoEmail], [Customers].[webpage] FROM Customers " & _
"INNER JOIN Customer_Addresses ON [Customers].[Customer_Code] =[Customer_Addresses].[Cust_Code]"
If rbtnAF.Checked = True Then
sql = "SELECT " & strFields & " WHERE [Customer_Addresses].[Cust_Code] BETWEEN " & _
"'A*' AND 'F*' ORDER BY [Customer_Addresses].[Cust_Code]"
Dim da As New OleDbDataAdapter(sql, con)
Dim ds As New DataSet
Dim dt As New System.Data.DataTable
da.Fill(ds)
dt = ds.Tables(0).Copy()
ugExport.DataSource = Nothing
ugExport.DataSource = dt
This was, I thought, working fine, I was able to load the correct ranges into the grid and export them as I wanted.
However, the user has come back to me and said it's not loading all customers.
I thought this was a bit weird, so I loaded up their database and tested it for myself. In the DB, there are 4 customers who fit into the range of A-F, as you can see in this image.
However, when I then view the customer range A-F in the export list, there are only 2 customers displayed.
It's also worth noting, in the Customer List screen there is a TextBox to allow the user to search by customer code - When I type in just a single F, all 4 customers are displayed as expected.
What on Earth is going on to only display 2 of the results in the Export List, despite there being 4 records that fit the criteria?
Checking the between syntax you will find that it treats * as a literal character see here https://support.office.com/en-us/article/Between-And-Operator-a435878d-63f7-4825-8c31-999432ae8223
You can use
Like "[A-F]*"
Instead though.
I have the below VBA code and A and B are holding some strings. I want to concatenate these values with some other strings and store the result in a different cell, but I want only the strings in A and B to be formatted as bold and the rest as normal text.
Set A = Worksheets("Mapping").Cells(rowNumber, columnNumber)
Set B = Worksheets("Mapping").Cells(rowNumber, 3)
' E.g.: A="currency", B="Small Int"
Worksheets("TestCases").Cells(i, 2) = "Verify the column " & A & " has same Data type " & B & " in code as well as Requirement document"
Expected output:
Verify the column currency has same Data type Small Int in code as well as Requirement document
Note: The values of A and B keep changing, so we cannot use the Characters() function.
Any help will be highly appreciated.
You can use the Characters() method - you just need to keep track of the length of the substrings. Personally, I would store the static strings in variables so that I can change them later without having to recalculate the indexes by hand:
' Untested
Set A = Worksheets("Mapping").Cells(rowNumber, columnNumber)
Set B = Worksheets("Mapping").Cells(rowNumber, 3)
Dim S1 = "Verify the column "
Dim S2 = " has same Data type "
Dim S3 = " in code as well as Requirement document"
With Worksheets("TestCases").Cells(i, 2)
.Value = S1 & A & S2 & B & S3
.Characters(Len(S1), Len(A)).Font.Bold
.Characters(Len(S1)+Len(A)+Len(S2), Len(B)).Font.Bold
End With
The function to change the font style is:
[Cells/Cell range].Font.FontStyle = "Bold"
Therefore something like might work:
Worksheets("Mapping").Cells(rowNumber, columnNumber).Font.FontStyle = "Bold"
You can also make things have underlines, strikethroughs etc... I found this really helpful blog post which goes through everything you should need to know:
http://software-solutions-online.com/excel-vba-formating-cells-and-ranges/#Jump4
I think you should have searched for this information yourself... Nevertheless this is the code that you should use to convert some cell data to bold:
Worksheets("Mapping").Cells(rowNumber, columnNumber).Font.Bold = True
At work I am required to reformat incorrect Addresses on a weekly basis from records in our Salesforce instance. We gather the incorrectly formatted addresses using a Report and export them to an Excel file. My job is simply to manipulate the data in the file to format them properly then reinsert them into the database.
Typically the addresses are formatted as so:
5 Sesame Street, Anytown, Anyplace
Separating these can be done easily by hand, but I typically have to work with hundreds of addresses at a time, and using default excel formulas tends to require lots of wrangling multiple cells at once to break it up into fragments.
Thus I wrote a custom formula to run through the cell and return a specific fragment of the string based on the "Comma Number" given. So if I give a Comma Number of 1, I would get "5 Sesame Street", 2 would get me "Anytown", etc.
Here is my code so far:
Public Function fragmentAddress(address As String, numberofcommas As Integer) As String
seen = 1
lastComma = -1
Dim x As Long
Dim frag As Long
For x = 0 To Len(address)
If Mid(address, x, 1) = "," & numberofcommas = seen Then
Exit For
ElseIf Mid(address, x, 1) = "," & numberofcommas <> seen Then
seen = seen + 1
lastComma = x
End If
Next
frag = Mid(address, lastComma + 1, seen - lastComma)
fragmentAddress = frag
I have not implemented the ability to handle the final value yet, but it does not give me any outputs, only outputting a "#VALUE!" error when I attempt to give it the input
=fragmentAddress("3 Ashley Close, Charlton Kings",1)
I have some experience with programming, but this is my first time writing anything in VBA.
Any help would be appreciated, thank you.
Not exactly sure what your question is, but this is simpler:
Public Function GetAddressFragment(ByVal Address As String, ByVal Index As Integer) As String
Dim addr() As String
addr = Split(Address, ",")
On Error Resume Next
GetAddressFragment = Trim(addr(Index - 1))
End Function
I wrote an export to CSV file in my vb.net application, and I then exported it into Outlook.
The issue I've got, is that when the CSV file is being written, my code is checking for a comma in the current field, but while doing this, it also mistakes a double space for a comma, or space followed by 'Enter' key being pressed (for multiline textboxes)
An example would be if in the notes section of the customer, there is 4 lines of text, and one ends in a space - The user has then pressed enter to go to the next line, however the program is taking the next line of text and creating a new record for it, as it thinks it's a comma...
What is the reason for this? This means that data has to be super validated (ie checking for no double spaces etc) before it can be exported, which is far too time consuming.
Hopefully this makes sense!
This is the code:
Dim result As Boolean = True
Try
Dim sb As New StringBuilder()
Dim separator As String = ","
Dim group As String = """"
Dim newLine As String = Environment.NewLine
For Each column As DataColumn In dtable.Columns
sb.Append(wrapValue(column.ColumnName, group, separator) & separator)
Next
sb.Append(newLine)
For Each row As DataRow In dtable.Rows
For Each col As DataColumn In dtable.Columns
sb.Append(wrapValue(row(col).ToString(), group, separator) & separator)
Next
sb.Append(newLine)
Next
The code for wrapValue
Function wrapValue(value As String, group As String, separator As String) As String
If value.Contains(separator) Then
If value.Contains(group) Then
value = value.Replace(group, group + group)
End If
value = group & value & group
End If
Return value
End Function
Based on the fact that it's shortening it by 430 lines, I'd suggest it's something to do with the fact you're adding a load of "" before and after the value variable.
If it's removing a value at the start, then it will be removing a " before the first column header. As to why it's importing one record as you mentioned in the comments, I'm not entirely sure, however, I would suggest the issue lies in your wrapValue code.
Can you try changing
value = group & value & group
to
value = value
and see if that changes anything?
My Problem is this:
I would like to use a custom ribbon Command button or even a simple command button inside the spreadsheet to initialize an OLEDB database connection and update/recalculate all the assoicated user defined functions that require such a connection, or those specified by me. I do not want any of these functions to recalculate except for when the specific button is clicked. I am having difficulty figuring out how to do this. Kindly offer your assistance or suggestions.
See below for Details on what I have done:
I currently store data within an access database from which I use vba in excel to make specific queries. I have embedded each datarequest routine within a group of functions under a module by the name [fnc]. I then access them as user-defined functions from within the excel spreadsheet. An example is given here:
Function ValueV(mm As String, yy As String, qtable As String, qcode As String, compare_period As Integer, average_period As Integer, weight As Boolean) As Variant
'Month Value Formula for Horizontal Data
'mm - month value 2-digit
'yy - year value 4-digit
'qtable - query table name eg. "cpia"
'qcode - query code for variable eg. "all0100"
'avgperiod - lag periods to average in calculation eg. 3-avgperiods for quarterly measure, 1-avgperiod for point measure.
'weight - boolean (true or false) value for weighting values given reference weight. Currently unsupported. Code should be extended to include this feature. (space holder for now)
Dim lag_value As Variant
Dim cur_value As Variant
lag_value = 0
cur_value = 0
'STEP-A: Gets the initial Value average or not.
'===============================================================
If compare_period > 0 Then
'Use this step to pickup initial value when compare_period <> 0 which requires a % change as opposed to a point value.
'Average_period must be greater than or equal to one (1). One (1) represents the current month which is the same as a point value.
lmm = fnc.lagdate(mm, yy, compare_period, "mm") 'lag month (a single month for mValueH)
lyy = fnc.lagdate(mm, yy, compare_period, "yy") 'lag year (a single month for mValueH)
smm = fnc.lagdate(mm, yy, compare_period + average_period - 1, "mm") 'dating backwards to account for average period
syy = fnc.lagdate(mm, yy, compare_period + average_period - 1, "yy") 'dating backwards to account for average period
'note, for smm & syy, the average period includes the lmm so we add back one (1)
'eg. 3-mth average is not 3-lags but current and 2-lags.
sdate1 = syy & fnc.numtext(smm)
'start date for query (begining of lag value including average period)
Set MyRecordset = New ADODB.Recordset
MySql = sql.sqlVSers(lmm, lyy, qtable, qcode, sdate1)
'MsgBox (MySql)
MyRecordset.Open MySql, MyConnect, adOpenStatic, adLockReadOnly
Do Until MyRecordset.EOF 'Loop to end and enter required values
lag_value = lag_value + MyRecordset(qcode)
MyRecordset.MoveNext
Loop
'Stop
lag_value = lag_value / average_period
MyRecordset.Close
End If
'STEP-B: Gets the current Value average or not.
'===============================================================
smm = fnc.lagdate(mm, yy, average_period - 1, "mm") 'dating backwards to account for average period
syy = fnc.lagdate(mm, yy, average_period - 1, "yy") 'dating backwards to account for average period
sdate1 = syy & fnc.numtext(smm)
'start date for query (begining of lag value including average period)
Set MyRecordset = New ADODB.Recordset
MySql = sql.sqlVSers(mm, yy, qtable, qcode, sdate1)
MyRecordset.Open MySql, MyConnect, adOpenStatic, adLockReadOnly
Do Until MyRecordset.EOF 'Loop to end and enter required values
cur_value = cur_value + MyRecordset(qcode)
MyRecordset.MoveNext
Loop
cur_value = cur_value / average_period
MyRecordset.Close
'STEP-C: Calculates the Requested % Change or Point Value.
'===============================================================
If compare_period = 0 Then
ValueV = cur_value
Else
ValueV = cur_value / lag_value * 100 - 100
End If
End Function
Since I totally bypass the use of a subroutine, the connection to the database is currently done as a workbook helper routine as shown below.
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim filePath
filePath = ThisWorkbook.Path
If Right$(filePath, 1) <> "\" Then filePath = filePath & "\"
MyConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & filePath & "rsdata.accdb;"
End Sub
Problem is, this updating process is less than desirable. Idealy, I would like to position a custom button inside the menu bar that (upon clicking it) will connect to the database and recalculate all the userdefined functions that are used in a given worksheet or workbook.
Please offer your suggestions or point to where something like this may have been done before.
Thanks in advance.
JR.
You are trying to use UDF's for something they are not designed to do. What they are designed to do is behave just like other cell formula, and be calcutaed when Excel decides they need to be.
You have two options
redesign your application to not use UDF's (IMO the best way)
modify your UDFs to only respond to a trigger specified by you, eg a button click (IMO a cludge and generally bad idea)
How to redesign to avoid UDF's depend on factors not disclosed in your OP