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]

Maybe I missed the worksheet part... all the code so far will do is "print" it to the immmediate window... for viewing... it's not for sending to a spreadsheet.

You'll need:
1. Reference to Microsoft Excel library (whichever you have)
2. Excel variables...
3. Extra bits in your code to set the values..

So you can do it that way, or you can put all your results into a table, and export that to Excel with DoCmd.TransferSpreadsheet.

I'll try to put an example together in a min on using Excel in this...

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

 

[Omnicube]

Thanks KJV - You are right, I need to send the values to the spreadsheet. Printing to the immediate window was great though because I saw how the code worked and learned about the immediate window.

I appreciate your willingness to help!

 

[kjv1611]

Okay... I forgot... even thought this is the Acces VBA forum, you're starting from Excel, and staying in Excel, right?

Just remember going forward, this sorta question should be posted to:
forum707

So now for the code...

You don't need a reference to Excel, since that's where you are already - not sure how I missed that.

Let's say your value is in Cell(1,1), or Range("A1"), and you want to just fill the values to the cells below that...

Just to do this without looking at your numbers, let's say the value in A1 is a,b,c,d,e,f,g and you want to have the same thing, but split out and transposed below.

Then..

Sub TransPoseMe
  Dim wb as Workbook
  Dim ws as Worksheet
  Dim intRow as Integer 'Excel Row
  Dim strSplitter() As String
  Dim x as Integer 'Array counter

  Set wb = ActiveWorkbook
  Set ws = wb.ActiveSheet

  intRow = 2 'going to assume you want to start just below row 1

  strSplitter = Split(ws.Cells(1,1).Value,",")
  For x = LBound(strSplitter) to UBound(strSplitter)
    ws.Cells(intRow,1).Value = strSplitter(x)
    intRow = intRow + 1
  Next x

  Erase strSplitter
  If ws Is Nothing Then Else Set ws = Nothing
  If wb Is Nothing Then Else Set wb = Nothing
  Msgbox "Value has been Split!","vbInformation,"Finished!"
End Sub

And you may want to check for typos, as I just typed it here in the thread-posting window.

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

 

[Omnicube]

Wow - that's great! It worked as is.

Sorry, the thread started as Access, but moved to Excel.

Just a couple questions.

* How can I get the script to move down the list of values? I have an entire column (maybe 500 rows) of values that are both delimited and values that do not need a delimiter because it one value (i.e. 123456789, instead of 123456789,987654321)

intRow = intRow + 1 should do this right?

I figured out how to parse the data to a new column so the new values would not overwrite any of the existing values.

* How can I get the corresponding values in column 2 (B) to transpose with all of the values that were parsed?

Example table:

Before Parse:

Column A Column B
123456789, 987654321 a
876543210, 223456789 b

After Parse
Column D Column E
123456789 a
987654321 a
876543210 b
223456789 b

Thanks again for all of your help!

 

[kjv1611]

Well, you'll need to basically expand what you've got so far.

So, you'll need to have one Row Integer for flowing through the original data rows, and another Row Integer (maybe Long to be safe) for flowing through the new cells.

So, something like...

Dim lngRowFrom As Long
Dim lngRowTo As Long
Dim x As Integer 'Loop through the array

lngRowTo = 2 
For lngRowFrom = 2 to ws.Range("A65000").End(xlUp).Row
'The "to" part is finding the last row, so you don't have to specify
   If InStr(ws.Cells(lngRowFrom,1).Value,",") Then
      strSplitter = Split(ws.Cells(lngRowFrom,1).Value,",")
      For x = LBound(strSplitter) to UBound(strSplitter)
         Do While ws.Cells(lngRowTo,3).Value = vbNullString
             lngRowTo = lngRowTo + 1
         Loop
         ws.Cells(lngRowTo,3).Value = strSplitter(x)
         ws.Cells(lngRowTo,4).Value = ws.Cells(lngRowFrom,2).Value
      Next x
   Else
      Do While ws.Cells(lngRowTo,3).Value = vbNullString
          lngRowTo = lngRowTo + 1
      Loop
      ws.Cells(lngRowTo,3).Value = ws.Cells(lngRowFrom,1).Value
      ws.Cells(lngRowTo,4).Value = ws.Cells(lngRowFrom,2).Value
      
   End If
Next lngRowFrom

Anyway, you can tie that into what you've got - make whatever fit where it needs to fit, and I think that'll work... may need some typo corrections again.






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

 

[kjv1611]

Oh... I didn't look at your column choices... A B, D E... so I assumed... A B, C D .... just make sure you set the columns where you want them.

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

 

[Omnicube]

Thanks for the code...

I was not sure if I needed to put the two code samples you provided together or if I needed to just add the variable def's from the first code snippet to the second. I tried both.

When I combined them, I got some errors. When I ran them independently, the first parsed the data to column C as directed. When I ran the second, it parsed all of the rows in column A into Column C Row 2 and values from Column B to Column D Row 2.

It looked something like this:

Column A Column B
123456789, 987654321 a
876543210, 223456789 b
654321987, 789456123 c


After Parse
Column C Column D
123456789 a
789456123 c
876543210 b
223456789 b

Notice, value in C2 is the same as the last value in A3 and the value in D2 is the value in B3.

 

[kjv1611]

Yeah, I didn't take the time to put it all together, but that was the general idea - combine the two. There is some editing required on your part to get it right, of course.

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

 

[Omnicube]

Thanks KJV for your help and patience.

I have tried several different ways to put this together and I am not able to identify the way that accomplishes my desired result. Could you help me?

Also, I read the help file on LBound and UBound but I do not understand what these functions do. Could you help me with that as well?

 

[Omnicube]

Also, I am not sure I understand how your macro recognizes the last value in the 'To' column. Will we need a EntireRow.Insert somewhere to ensure that values are not replaced?

 

[Omnicube]

Good news, I think that I got most of it to work, but I am seeing the code freeze and am having to break at the second loop.

Sub ParseTest()

Dim wb As Workbook
Dim ws As Worksheet
Dim lngRowFrom As Long
Dim lngRowTo As Long
Dim x As Integer 'Loop through the array
Dim strSplitter() As String

Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

lngRowTo = 1
For lngRowFrom = 1 To ws.Range("A65000").End(xlUp).Row
'The "to" part is finding the last row, so you don't have to specify
   If InStr(ws.Cells(lngRowFrom, 1).Value, ",") Then
      strSplitter = Split(ws.Cells(lngRowFrom, 1).Value, ",")
      For x = LBound(strSplitter) To UBound(strSplitter)
        ws.Cells(lngRowTo, 3).Value = strSplitter(x)
            Do While ws.Cells(lngRowTo, 3).Value = vbNullString
            Loop
         ws.Cells(lngRowTo, 3).Value = strSplitter(x)
         ws.Cells(lngRowTo, 4).Value = ws.Cells(lngRowFrom, 2).Value
         lngRowTo = lngRowTo + 1
      Next x
   Else
      Do While ws.Cells(lngRowTo, 3).Value = vbNullString
      Loop
      ws.Cells(lngRowTo, 3).Value = ws.Cells(lngRowFrom, 1).Value
      ws.Cells(lngRowTo, 4).Value = ws.Cells(lngRowFrom, 2).Value
   
   End If
Next lngRowFrom

End Sub

Also, although each of the delimited values and their corresponding error #'s were parsed correctly, the value without the delimiter was not parsed before the code froze.

Any ideas? I am really trying to understand how all of this works as I am trying to teach myself the nuances of VBA.

 

[Omnicube]

I changed the "to" columns in the Else statement to 5 and 6 (respectively), and the code "printed" the values only immediately before any values with delimiters.

i.e. See below:
Before Parse
Column A Column B
123456789, 987654321 a
654987321 b
123789456 c
876543210, 223456789 d
654321987, 789456123 e

After Parse
Column A Column B Column C Column D
123456789 a 123789456 c
987654321 a
876543210 d
223456789 d
654321987 e
789456123 e

The code ignored the value 654987321 with error value b.

I am not sure if this feedback is helping or not, but I wanted to provide as much information as I can.

 

[Omnicube]

Finally got it figured out. One more question, how can I validate strSplitter to make sure it is numeric? This was discussed earlier in the thread, but I am not sure where to place the IsNumeric function in the below code.

Sub ParseTest()

Dim wb As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lngRowFrom As Long
Dim lngRowTo As Long
Dim x As Integer 'Loop through the array
Dim strSplitter() As String

Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
Set ws2 = Sheet2


lngRowTo = 2
For lngRowFrom = 2 To ws.Range("A65000").End(xlUp).Row
'The "to" part is finding the last row, so you don't have to specify
   If InStr(ws.Cells(lngRowFrom, 1).Value, ",") Then
      strSplitter = Split(ws.Cells(lngRowFrom, 1).Value, ",")
      For x = LBound(strSplitter) To UBound(strSplitter)
        ws.Cells(lngRowTo, 7).Value = strSplitter(x)
            Do While ws.Cells(lngRowTo, 7).Value = vbNullString
            Loop
         ws.Cells(lngRowTo, 7).Value = strSplitter(x)
         ws.Cells(lngRowTo, 8).Value = ws.Cells(lngRowFrom, 2).Value
         ws.Cells(lngRowTo, 9).Value = ws.Cells(lngRowFrom, 3).Value
         ws.Cells(lngRowTo, 10).Value = ws.Cells(lngRowFrom, 4).Value
         ws.Cells(lngRowTo, 11).Value = ws.Cells(lngRowFrom, 5).Value
         lngRowTo = lngRowTo + 1
       Next x
    Else
        Do While ws.Cells(lngRowTo, 7).Value = vbNullString
        ws.Cells(lngRowTo, 7).Value = ws.Cells(lngRowFrom, 1).Value
        ws.Cells(lngRowTo, 8).Value = ws.Cells(lngRowFrom, 2).Value
        ws.Cells(lngRowTo, 9).Value = ws.Cells(lngRowFrom, 3).Value
        ws.Cells(lngRowTo, 10).Value = ws.Cells(lngRowFrom, 4).Value
        ws.Cells(lngRowTo, 11).Value = ws.Cells(lngRowFrom, 5).Value
        Loop
        lngRowTo = lngRowTo + 1
   End If

Next lngRowFrom


End Sub

I tried placing it in the code before the InStr but I still got all of the values that are not numeric.

 

[kjv1611]

Well, if you want to test the values of each split-out item, then you'll need to do it in the loop where you're looping through the array variable of the values... so somewhere like:

      For x = LBound(strSplitter) To UBound(strSplitter)
[HIGHLIGHT]If IsNumeric(strSplitter(x)) Then[/HIGHLIGHT]
        ws.Cells(lngRowTo, 7).Value = strSplitter(x)
            Do While ws.Cells(lngRowTo, 7).Value = vbNullString
            Loop
         ws.Cells(lngRowTo, 7).Value = strSplitter(x)
         ws.Cells(lngRowTo, 8).Value = ws.Cells(lngRowFrom, 2).Value
         ws.Cells(lngRowTo, 9).Value = ws.Cells(lngRowFrom, 3).Value
         ws.Cells(lngRowTo, 10).Value = ws.Cells(lngRowFrom, 4).Value
         ws.Cells(lngRowTo, 11).Value = ws.Cells(lngRowFrom, 5).Value
         lngRowTo = lngRowTo + 1
       Next x

Sorry... not much time to go much further in detail than that, but if you've gotten this far, I think you can handle it.




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