MS Access - Replacing Part of a String

Had another issue where we needed to replace a section of a string with another input string, here is the function I came up with.

to use it you need to enter three elements, 1) the String to be changed, 2) The Part to be Removed, 3) The String to Replace it.

so for example ReplaceString("This is the Start","Start","End") Where the String is "This is the Start" and the function will replace "Start" with "End" so that the Output of the Above function is "This is the End"

Function ReplaceString(ByVal strString As String, ByVal strOld As _
String, ByVal strNew As String) As String


Dim lngCount As Long
Dim strChange As String

strChange = strString
lngCount = InStr(strChange, strOld)

Do While lngCount > 0
strChange = Left(strChange, lngCount - 1) & Replacevalue & _
Mid(strChange, lngCount + Len(strOld))
lngCount = InStr(lngCount + Len(strNew), strChange, strOld, 1)
Loop

ReplaceString = strChange

End Function

Nerd Humour and Cross Tab Issue

First a little Nerd joke.

"There are only 10 types of people in the world, those who understand binary, and those who don't."

Anyway,

Have had a slight issue this morning trying to load a crosstab query into a recordset to append to an excel sheet - When does this not bother me at 6am on a Sunday!!

Anyway the issue is in trying to transfer the information to a spreadsheet with the column heads, obviously it is quite easy to transfer the data but the column heads are trickier as with a cross tab query they could be different each time. anyway I managed to sort out a code snip which will populate the column headings.

Private Sub TransferCrossTab()

Dim myQdef As QueryDef
Dim rsReport As Recordset
Dim appXl As Excel.Application
Dim appxlWB As Excel.Workbook
Dim appXlWS As Excel.Worksheet
Dim lngColNbr As Long
Dim xlc As Object

Set myQdef = CurrentDb.QueryDefs("qry_monthlyquery_agb") 'open crosstab query
Set appXl = CreateObject("Excel.Application")
Set appxlWB = appXl.Workbooks.Open(strfilepath, , False)
'open spreadsheet "Here Stored as global variable"
Set appXlWS = appxlWB.Sheets("Source_Data")
Set xlStart = appXlWS.Range("B1")

appXlWS.Range("B1:AY453").ClearContents 'Clear Contents from Spreadsheet
For lngcolNbr = 0 To rsReport.Fields.Count - 1
xlStart.Offset(0, lngcolnbr).Value = rsReport.Fields(lngcolnbr).Name 'For Each Field in Recordset provide column heading
Next lngcolnbr
Set xlc = xlc.Offset(1, 0)
appXlWS.Range("B2").CopyFromRecordset rsReport 'Add Recordset Data

End Sub

Hope this makes sense, Haven't really got time to go over it at present but if this sounds like it may help you feel free to get in touch.

Null values in Select function - VBA Access

I have been asked about how you can trigger an event in a SELECT CASE when there is a null value. (As you can not have null as a case)

The answer is actually incredibly easy, you use the nz() function, NZ returns a variable you can set when there is a null value, it needs to arguments.

1. the field to be evaluated
2. What to replace the Null value with

nz([Field to be Evaluated],[Value to Return if Null])

in this quick example I want to return a message box if the field is null.

SELECT CASE nz(me.nullfield,0) 'This will replace a null value with a 0
CASE 0
msgbox "Error, value Needed"
CASE "Value 1"
msgbox "Value 1 Selected"
CASE "Value 2"
msgbox "Value 2 Selected"
END SELECT

obviously if "0" is one of your CASE values you can replace it with a string i.e. "None"

Week Ending Function VBA

Just Finished working on a problem for a DB, the client wants all their reporting to be based on Week Ending dates but their files are stored by Date. How can you summarise per week?

I sorted it by creating a function I could then include in my queries -

Public Function WeekEnding(Actual as variant) As Variant
If IsDate(Actual) Then 'Check that variable is a date
WeekEnding = DateAdd("d", Actual, 7-Weekday(Actual)) 'Add on 7 days minus variable day
End If

End Function

Access Date Format Issues

I have been asked by a few people how to solve the issue that when you are sending data from Excel to Access (and vice versa) in VBA the dates get flipped into US format :- MM/DD/YYYY instead of DD/MM/YYYY now this will only happen when you the day of the date is less than 12, the issue comes from the way the Excel or Access interperate the date it recieves. annoyingly it does not give any regard to the regional settings.

Anyway the way I found to get around it is using a function to convert the date into a format that can not confuse the system.

Public Function Fixdate(ByVal str)

Dim dteDay
Dim dteMonth
Dim dteYear

If isnull(str) Then
msgbox "Error"
Exit Function
End If

dteDay = Day(str)
dteMonth = MonthName(Month(str), True)
dteYear = Year(str)

FixDate = dteDay & "-" & dteMonth & "-" & dteYear

End Function

This is then used as follows

myDate = fixdate(date)

This will return a value to mydate as 25-May-2010 which Excel or Access will be able to interperate as the correct date.

Trim Address Functions

I have been working on a new database and have found the need to separate a combined text field into various columns, obviously you can do this using the Left and Right Trim functions but how do you trim a combined text field into parts that are not fixed width?

For this example I will use an address field txt_Address which contains addresses of in determinant length. To do this you need to split it up by each address field in this field these are identified by commas

First step therefore is to identify the commas as each comma needs to be placed on a different line.

(Len([txt_Address])-Len(Replace([txt_Address],",","")))/1 This will tell you how many comma’s there are.

As you can see some of the addresses do not have a comma, so when we write our first expression we need to qualify if there is a comma to split by and if not to just add the whole field

Address Line 1 =

IIf(((Len([txt_Address])-Len(Replace([txt_Address],",","")))/1)=0,[txt_Address], Left([txt_Address],InStr(1,[txt_Address],",")-1))

The Address Line 2 query is obviously different for each field depending on how many commas are present, start the expression again by checking how many commas present and if it is less than 1 return a blank field.

IIf(((Len([txt_Address])-Len(Replace([txt_Address],",","")))/1)=0,"",>

If there is a comma however then you need to trim from the first comma

Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],",")

However if there is more than one comma you need to left trim the newly created field to just take the first line. You can do this by replacing the above right trim into the first left trim in place of the field names.

You get a very confusing looking Address Line 2 =

IIf(((Len([txt_Address])-Len(Replace([txt_Address],",","")))/1)=0,"",IIf(((Len([txt_Address])-Len(Replace([txt_Address],",","")))/1)=1,Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],",")),Left(Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],",")),InStr(1,Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],",")),",")-1))) It looks very confusing but it works

If you wish to have more than three address lines then you simply need to keep shortening the trimmed value by one comma at a time until you can “left” the part that you want. For this one however I will place everything else onto a third line for simplicities sake.

This simply uses the above functions in place of the actual field name

Adress Line 3 =

IIf(((Len([txt_Address])-Len(Replace([txt_Address],",","")))/1)=1,"",right(trim(right(trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],","))),Len(Trim(Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],","))))-InStr(1,Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],",")),",")))

So the final Query is as follows:

SELECT txt_Address, txt_PostCode, IIf(((Len([txt_Address])-Len(Replace([txt_Address],",","")))/1)=0,[txt_Address],Left([txt_Address],InStr(1,[txt_Address],",")-1)) AS [Address Line 1], IIf(((Len([txt_Address])-Len(Replace([txt_Address],",","")))/1)=0,"",IIf(((Len([txt_Address])-Len(Replace([txt_Address],",","")))/1)=1,Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],",")),Left(Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],",")),InStr(1,Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],",")),",")-1))) AS [Address Line 2], IIf(((Len([txt_Address])-Len(Replace([txt_Address],",","")))/1)=1,"",right(trim(right(trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],","))),Len(Trim(Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],","))))-InStr(1,Right(Trim([txt_Address]),Len(Trim([txt_Address]))-InStr(1,[txt_Address],",")),","))) AS [Adress Line 3], (Len([txt_Address])-Len(Replace([txt_Address],",","")))/1 AS [Comma Count] FROM tbl_MainData_agb;

Maybe next time I will just insist that they place each line in a separate field.