Help Understanding Code 3

[Omnicube]

I need some help understanding this code. I am trying to understand a previous programmers coding and I am only a beginner with VBA coding. Any help is appreciated.

Option Compare Database


Function UpdateAmounts() As Boolean


Dim db As Database
Dim tdf As TableDef
Dim fld As Field
Dim rst As Recordset
Dim strSQL As String

Dim db1 As Database
Dim tdf1 As TableDef
Dim fld1 As Field
Dim rst1 As Recordset
Dim strSQL1 As String

Dim strTableName As String
Dim strTableName1 As String

Dim Delimiter As String


ReDim SubStrs(0) As String
Dim CurPos As Long
Dim NextPos As Long
Dim DelLen As Integer
Dim nCount As Integer
Dim xCount As Integer
Dim TStr As String
Dim sortkeylast As String
Dim sortkeynext As String
Dim servernamesCSV As String


strTableName = "at"
strTableName1 = "at1"
Delimiter = ", "


Set db = CurrentDb()
Set db1 = CurrentDb()

On Error GoTo Err_Execute


Set rst1 = db1.OpenRecordset(strTableName1, dbOpenTable)


readfirst:

Set rst = db.OpenRecordset(strTableName, dbOpenTable)
rst.Index = "f1"

rst.MoveFirst

sortkeylast = rst![f2]

nCount = 1

rst1.AddNew

rst1![f1] = rst![f1]
rst1![f2] = rst![f2]
rst1![f3] = rst![f3]
rst1![f4] = rst![f4]
rst1![f5] = rst![f5]
rst1![f6] = rst![f6]
rst1![f7] = rst![f7]
rst1![f8] = rst![f8]
rst1![f9] = rst![f9]
rst1![f10] = rst![f10]
rst1![f11] = rst![f11]
rst1![f12] = rst![f12]
rst1![f13] = rst![f13]
rst1![f14] = rst![f14]



rst1![f15] = rst![f15]
rst1![f16] = rst![f16]
rst1![f17] = rst![f17]
rst1![f18] = rst![f18]
rst1![f19] = rst![f19]
rst1![f20] = rst![f20]
rst1![f21] = rst![f21]
rst1![f22] = rst![f22]
rst1![f23] = rst![f23]
rst1![f24] = rst![f24]

servernamesCSV = rst![f25]

rst1![f26] = rst![f26]
rst1![f27] = rst![f27]
rst1![f28] = rst![f28]
rst1![f29] = rst![f29]
rst1![f30] = rst![f30]
rst1![f31] = rst![f31]
rst1![f32] = rst![f32]
rst1![f33] = rst![f33]
rst1![f34] = rst![f34]
rst1![f35] = rst![f35]

rst1![f36] = rst![f36]
rst1![f37] = rst![f37]
rst1![f38] = rst![f38]
rst1![f39] = rst![f39]
rst1![f40] = rst![f40]
rst1![f41] = rst![f41]

rst1![f42] = rst![f42]
rst1![f43] = rst![f43]

rst1![f44] = rst![f44]
rst1![f45] = rst![f45]
rst1![f46] = rst![f46]
rst1![f47] = rst![f47]




Do Until rst.EOF

rst.MoveNext

If rst.EOF Then GoTo readnext:

sortkeynext = rst![f2]

If sortkeylast <> sortkeynext Then GoTo sortbreak:

If Len(Trim(rst![f25])) > 0 Then servernamesCSV = servernamesCSV & Delimiter & Trim(rst![f25])

nCount = nCount + 1

GoTo readnext:


sortbreak:

rst1![f25] = servernamesCSV
rst1![f40] = nCount

rst1![f2] = sortkeylast

rst1.Update

sortkeylast = sortkeynext

rst1.AddNew

rst1![f1] = rst![f1]
rst1![f2] = rst![f2]
rst1![f3] = rst![f3]
rst1![f4] = rst![f4]
rst1![f5] = rst![f5]
rst1![f6] = rst![f6]
rst1![f7] = rst![f7]
rst1![f8] = rst![f8]
rst1![f9] = rst![f9]
rst1![f10] = rst![f10]
rst1![f11] = rst![f11]
rst1![f12] = rst![f12]
rst1![f13] = rst![f13]

rst1![f14] = rst![f14]

rst1![f15] = rst![f15]
rst1![f16] = rst![f16]
rst1![f17] = rst![f17]
rst1![f18] = rst![f18]
rst1![f19] = rst![f19]
rst1![f20] = rst![f20]
rst1![f21] = rst![f21]
rst1![f22] = rst![f22]
rst1![f23] = rst![f23]
rst1![f24] = rst![f24]

servernamesCSV = rst![f25]
nCount = 1


rst1![f26] = rst![f26]
rst1![f27] = rst![f27]
rst1![f28] = rst![f28]
rst1![f29] = rst![f29]
rst1![f30] = rst![f30]
rst1![f31] = rst![f31]
rst1![f32] = rst![f32]
rst1![f33] = rst![f33]
rst1![f34] = rst![f34]
rst1![f35] = rst![f35]

rst1![f36] = rst![f36]
rst1![f37] = rst![f37]
rst1![f38] = rst![f38]
rst1![f39] = rst![f39]
rst1![f40] = rst![f40]
rst1![f41] = rst![f41]

rst1![f42] = rst![f42]
rst1![f43] = rst![f43]

rst1![f44] = rst![f44]
rst1![f45] = rst![f45]
rst1![f46] = rst![f46]
rst1![f47] = rst![f47]




readnext:


Loop


writelast:

rst1![f25] = servernamesCSV
rst1![f40] = nCount

rst1.Update

rst.Close
rst1.Close
Set rst = Nothing
Set rst1 = Nothing
Set db = CurrentDb()
Set db1 = CurrentDb()

UpdateAmounts = True

On Error GoTo 0

Exit Function

Err_Execute:
UpdateAmounts = False


End Function

 

[kjv1611]

I tried to make it a little easier to look at, so here's it cleaned up a little bit (extra spaces taken out, that sort of thing - no actual changes to the code), and put in a code block:

Option Compare Database

Function UpdateAmounts() As Boolean

    Dim db As Database
    Dim tdf As TableDef
    Dim fld As Field
    Dim rst As Recordset
    Dim strSQL As String
    
    Dim db1 As Database
    Dim tdf1 As TableDef
    Dim fld1 As Field
    Dim rst1 As Recordset
    Dim strSQL1 As String
    
    Dim strTableName As String
    Dim strTableName1 As String
    
    Dim Delimiter As String
     
    ReDim SubStrs(0) As String
    Dim CurPos As Long
    Dim NextPos As Long
    Dim DelLen As Integer
    Dim nCount As Integer
    Dim xCount As Integer
    Dim TStr As String
    Dim sortkeylast As String
    Dim sortkeynext As String
    Dim servernamesCSV As String
    
    strTableName = "at"
    strTableName1 = "at1"
    Delimiter = ", "
    
    Set db = CurrentDb()
    Set db1 = CurrentDb()
    
    On Error GoTo Err_Execute
    
    Set rst1 = db1.OpenRecordset(strTableName1, dbOpenTable)
    
readfirst:

	Set rst = db.OpenRecordset(strTableName, dbOpenTable)
	rst.Index = "f1"
    
    rst.MoveFirst
        
    sortkeylast = rst![f2]
    
    nCount = 1
    
    rst1.AddNew
    rst1![f1] = rst![f1]
    rst1![f2] = rst![f2]
    rst1![f3] = rst![f3]
    rst1![f4] = rst![f4]
    rst1![f5] = rst![f5]
    rst1![f6] = rst![f6]
    rst1![f7] = rst![f7]
    rst1![f8] = rst![f8]
    rst1![f9] = rst![f9]
    rst1![f10] = rst![f10]
    rst1![f11] = rst![f11]
    rst1![f12] = rst![f12]
    rst1![f13] = rst![f13]
    rst1![f14] = rst![f14]
    rst1![f15] = rst![f15]
    rst1![f16] = rst![f16]
    rst1![f17] = rst![f17]
    rst1![f18] = rst![f18]
    rst1![f19] = rst![f19]
    rst1![f20] = rst![f20]
    rst1![f21] = rst![f21]
    rst1![f22] = rst![f22]
    rst1![f23] = rst![f23]
    rst1![f24] = rst![f24]

    servernamesCSV = rst![f25]
    
    rst1![f26] = rst![f26]
    rst1![f27] = rst![f27]
    rst1![f28] = rst![f28]
    rst1![f29] = rst![f29]
    rst1![f30] = rst![f30]
    rst1![f31] = rst![f31]
    rst1![f32] = rst![f32]
    rst1![f33] = rst![f33]
    rst1![f34] = rst![f34]
    rst1![f35] = rst![f35]
    rst1![f36] = rst![f36]
    rst1![f37] = rst![f37]
    rst1![f38] = rst![f38]
    rst1![f39] = rst![f39]
    rst1![f40] = rst![f40]
    rst1![f41] = rst![f41]
    rst1![f42] = rst![f42]
    rst1![f43] = rst![f43]
    rst1![f44] = rst![f44]
    rst1![f45] = rst![f45]
    rst1![f46] = rst![f46]
    rst1![f47] = rst![f47]
        
	Do Until rst.EOF
		rst.MoveNext
		If rst.EOF Then GoTo readnext:
		sortkeynext = rst![f2]
		If sortkeylast <> sortkeynext Then GoTo sortbreak:
		If Len(Trim(rst![f25])) > 0 Then servernamesCSV = servernamesCSV & Delimiter & Trim(rst![f25])
		nCount = nCount + 1
		GoTo readnext:

sortbreak:

		rst1![f25] = servernamesCSV
		rst1![f40] = nCount
		rst1![f2] = sortkeylast
		rst1.Update
		sortkeylast = sortkeynext

		rst1.AddNew
		rst1![f1] = rst![f1]
		rst1![f2] = rst![f2]
		rst1![f3] = rst![f3]
		rst1![f4] = rst![f4]
		rst1![f5] = rst![f5]
		rst1![f6] = rst![f6]
		rst1![f7] = rst![f7]
		rst1![f8] = rst![f8]
		rst1![f9] = rst![f9]
		rst1![f10] = rst![f10]
		rst1![f11] = rst![f11]
		rst1![f12] = rst![f12]
		rst1![f13] = rst![f13]
		rst1![f14] = rst![f14]
		rst1![f15] = rst![f15]
		rst1![f16] = rst![f16]
		rst1![f17] = rst![f17]
		rst1![f18] = rst![f18]
		rst1![f19] = rst![f19]
		rst1![f20] = rst![f20]
		rst1![f21] = rst![f21]
		rst1![f22] = rst![f22]
		rst1![f23] = rst![f23]
		rst1![f24] = rst![f24]
		
		servernamesCSV = rst![f25]
		nCount = 1
		
		rst1![f26] = rst![f26]
		rst1![f27] = rst![f27]
		rst1![f28] = rst![f28]
		rst1![f29] = rst![f29]
		rst1![f30] = rst![f30]
		rst1![f31] = rst![f31]
		rst1![f32] = rst![f32]
		rst1![f33] = rst![f33]
		rst1![f34] = rst![f34]
		rst1![f35] = rst![f35]
		rst1![f36] = rst![f36]
		rst1![f37] = rst![f37]
		rst1![f38] = rst![f38]
		rst1![f39] = rst![f39]
		rst1![f40] = rst![f40]
		rst1![f41] = rst![f41]
		rst1![f42] = rst![f42]
		rst1![f43] = rst![f43]
		rst1![f44] = rst![f44]
		rst1![f45] = rst![f45]
		rst1![f46] = rst![f46]
		rst1![f47] = rst![f47]
   
readnext:
    
	Loop

writelast:

	rst1![f25] = servernamesCSV
	rst1![f40] = nCount
	rst1.Update

    rst.Close
    rst1.Close
    Set rst = Nothing
    Set rst1 = Nothing
    Set db = CurrentDb()
    Set db1 = CurrentDb()

    UpdateAmounts = True
    
    On Error GoTo 0

    Exit Function

Err_Execute:
    UpdateAmounts = False

 End Function

So, is it working/not working? What is it you don't understand about it? Frankly, many of us could walk through it and mention what every little piece is, but much of it will easily be found in the help files.

If you are now maintaining the code, I will say that in my opinion, at first glance, it looks poorly written. SURELY there is a way to do what is being done without so many "GoTo" statements. That's what makes it painful to follow, and downright ludicrous of a layout.

Also, the lines that say:
rst1![f12] = rst![f12] and the like? You could easily put them into loops, so it's much easier to read... so it'd be something like:
(After Dimming x as an Integer)

For x = 1 to 24
   rst1.Fields(x) = rst.Fields(x)
Next x

servernameCSV = rst.Fields(25)

For x = 26 to 47
   rst1.Fields(x) = rst.Fields(x)
Next x

And that's assuming it can't be done as simply as :

For x = 1 to 47
   rst1.Fields(x) = rst.Fields(x)
Next x

servernameCSV = rst.Fields(25)

And really, that may not even be necessary. It almost looks to me that the easiest way to do it would be with a query or a raw SQL statement if preferred, rather than tell it to update 50 fields (or whatever the final # is).

Another suggestion? Don't just use Database, same goes for the other database objects... use DAO.Database. So your Dim statements would work better as:

Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim rst AS DAO.Recordset

Of course, if you're using a version prior to 2007, you'll need to set a reverence to the DAO 3.6 (or other #s) library.

Any thoughts so far? You really need to share more about what you're doing - did you just happen upon the code, or are you now responsible for maintaining it, for instance? Any problems? Tell us something.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[Omnicube]

Thanks for the suggestions on trimming the fat off the code.

Yes, I am responsible for maintaining the code now. I understand what the code is designed to do, I am just having trouble with the flow.

The code is designed to take multiple records which are related to one primary key and concatenate the values, as they related to the primary key, in another column.

For example, if I have record one and apples, oranges, and bananas are related to record one the view will look something like this:

ID Number Status
1 Apples, Oranges, Bananas

Before, the data, in Excel looked like this

ID Number Status
1 Apples
1 Oranges
1 Bananas

The original programmer ported the data to Access to clean up the data. I am thinking that I can code something in Excel to perform the same function; however, I wanted to understand the nuances of the above code before I tried to manipulate it.

p.s. How do you use code blocks on this forum? Is it just

 [\code]?

 

[PHV]

take multiple records which are related to one primary key and concatenate the values
Have a look here:
faq701-4233

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Andrzejek]

I would be really tempted to do

For x = 1 to [blue]rst1.Fields.Count[/blue]
   rst1.Fields(x) = rst.Fields(x)
Next x

servernameCSV = rst.Fields(25)

if all the Fields from rst1 need to be there.

Use code blocks on this forum - Is it just [ignore]

[/ignore] For more options look here


Have fun.

---- Andy

 

[kjv1611]

regarding code blocks:

Just below the text box where you type your question/response in these fora, you can click Process TGML at any time, and you'll get a pop-up window listing the various formattings you can use in your postings. You'll get the same thing that Andy linked to.

Also, if you did want to do it in Excel, you might could just use the Concatenatefunction. Depending upon the layout, frequency, etc...

So, you might be able to transpose the data then concatenate...

Or that may not work... here's another idea... Microsoft has a short snippet of code on their site to do it in Excel, based on the selected cell...

http://support.microsoft.com/kb/213477

Sounds like it would do what you need... or almost what you need.. if there is anything to look for, to know when to go to the next record, then you'd need to add that into the code of course..


"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[Omnicube]

Thank you guys! I am going to give this a shot.

In another data set I need to parse, into different records, values with a delimiter of ",". Example below:

Starting Record:
123456789, 012345678, 987654321, 876543210

I need the ending record to look like this:

123456789
012345678
987654321
876543210

Any ideas for something like this?

 

[PHV]

Have a look at the Split function

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[kjv1611]

On the Split Function, you'll need an Array variable, and then use an Integer to loop through the pieces of the array.

Chip Pearson's pages have been very useful to me in the past. Here's one on the Split function (of course you can check the help file as well):

http://www.cpearson.com/excel/splitondelimiters.aspx

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[Omnicube]

Thanks again guys! I have been able to find some good examples on the split function.

Unfortunately, I have not been able to identify a good way for me to do what I am looking to do.

My original data set looks like this:

Column A Column B
ID Numbers Error
1, 2, 3, 4, 5 a
6, 7, 8, 9, 10 b
11 c

I need to parse out each ID number for each error. So, I would like my end data set to look like this.

Column A Column B
ID Numbers Error
1 a
2 a
3 a
4 a
5 a
6 b
7 b
8 b
9 b
10 b
11 c

These values exist already in cell A1 (for example). I would like the new values to be inserted into cells A1:A5 without compromising any values that are contained below A1.

Something else I am looking to do is trim the the values from column A as there is a space between the first and second delimited values.

Finally, some values might look like this:

Column A Column B
ID Number Error
12 (ABC) d

This ID is an invalid number and should not be parsed into the final data set. The ID number is invalid because ID numbers cannot have text. (The system of record with which I am working lacks rules and users can whatever values they want.) Not sure if VBA can find a cell with text in it and not include it in the final array, but it would be great if this portion could be included. Any help?

 

[Andrzejek]

You may use some simple logic like this:

Dim s() As String
Dim x As Integer
Dim str As String

str = "1, 2, 3, 4, 5"
s = Split(str, ",")

For x = LBound(s) To UBound(s)
    Debug.Print [blue]CInt(s(x))[/blue]
Next x

The BLUE part of the code will give you an error for value of 12 (ABC) since it cannot be changed into an Integer with CInt which you can catch and do .... whatever.

Have fun.

---- Andy

 

[Omnicube]

Thanks for the example. I tried to use this as my code:

Public Sub test()
   
Dim s() As String
Dim x As Integer
Dim str As String

str = Cells(1, 1)
s = Split(str, ",")

For x = LBound(s) To UBound(s)
    Debug.Print CInt(s(x))
Next x

End Sub

I got an overflow error on the debug.print.

My data is set up like as mentioned above.

 

[Andrzejek]

So your value in Cella(1, 1) which is A1 is "1, 2, 3, 4, 5"?
And that gives you an overflow error?

Unless you have in A1 something like "123456789, 012345678, 987654321, 876543210" then you will get the overflow error because Integer will not hadle numbers grater than 37000 or so.

But if you want your results back as:
123456789[blue]
012345678[/blue]
987654321
876543210

The blue line will be a problem because it si NOT a number, has leading zero.

But try soething like this:

Dim s() As String
Dim x As Integer
Dim str As String

str = "123456789, 012345678, 987654321, 876543210, 12 (ABC)"
s = Split(str, ",")

For x = LBound(s) To UBound(s)
    s(x) = Trim(s(x))
    If IsNumeric(s(x)) Then
        Debug.Print s(x)
    Else
        Debug.Print "Not a Number"
    End If
Next x

IsNumeric will not always work, it will take a value like 11e2 and some other scientific notations as a valid number, so be careful.

Have fun.

---- Andy

 

[Omnicube]

My values can get up to 9 digits, but will never start with a zero.

I tried both of the following:

Changed the data type to Long

Public Sub test()

Dim s() As String
Dim x As Long
Dim str As String

str = Cells(1, 1)
s = Split(str, ",")

For x = LBound(s) To UBound(s)
    Debug.Print CInt(s(x))
Next x

End Sub

Got an overflow error again.

and

Public Sub test3()

Dim s() As String
Dim x As Long
Dim str As String

str = Cells(1, 1)
s = Split(str, ",")

For x = LBound(s) To UBound(s)
    s(x) = Trim(s(x))
    If IsNumeric(s(x)) Then
        Debug.Print s(x)
    Else
        Debug.Print "Not a Number"
    End If

Next x

End Sub

Nothing happened when I ran this.

 

[Andrzejek]

What happens when you do this:

Public Sub test3()

Dim s() As String
Dim x As Integer
Dim str As String

str = Cells(1, 1)
[blue]
Debug.Print str
[/blue]
s = Split(str, ",")

For x = LBound(s) To UBound(s)
    s(x) = Trim(s(x))
    If IsNumeric(s(x)) Then
        Debug.Print s(x)
    Else
        Debug.Print "Not a Number"
    End If
Next x

End Sub

What do you have at the [tt]Debug.Print[/tt] line of code in Immediate Window?

Have fun.

---- Andy

 

[kjv1611]

Just to be sure you're on the same page... If you don't see a window below your code in VBA, make sure you have the VB Editor as the active window, and press <Ctrl>+<G>, and you'll see it.

When you said "nothing happened", that made me think that perhaps you're not seeing the "immediate" window at all. You can also find the option to enable/disable it under the View menu.

"But thanks be to God, which giveth us the victory through our Lord Jesus Christ." 1 Corinthians 15:57

 

[Omnicube]

DOH! Thanks KJV! I found the immediate window!

Code works like a charm! You're awesome Andrzejek!

How can I get it to fill the values down in the sheet? I did not see it copy the corresponding values from column B in the immediate window. Will they carry over once they print to the sheet?

 

[Andrzejek]

I know, I know I am awesome

Looks to me like you need to add [tt]UBound(s) + 1[/tt] rows to your Excel file and populate the rows with the values: Columns A from an array [tt]s[/tt] and column B with the same value of ColB.

Have fun.

---- Andy

 

[Omnicube]

Thanks for your prompt response Andy.

I am not sure that I understand what you mean by adding Ubound(s) + 1 rows to my excel file.

Can you help me wrap my head around this concept?

 

[Omnicube]

I tried to add + 1 after the UBound(s) in the code you provided, but that did not print to the worksheet.

Thanks again for your help