Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]

Groups > microsoft.public.excel.programming > #108880 > unrolled thread

Modify Code to loop back through table after its been updated and process it

Back to article view | Back to microsoft.public.excel.programming

Contents

  Modify Code to loop back through table after its been updated and process it TimLeonard <TimLeonard.119a37a8@excelbanter.com> - 2016-06-05 20:21 +0100
    Re: Modify Code to loop back through table after its been updated and process it GS <gs@v.invalid> - 2016-06-05 20:06 -0400
      Re: Modify Code to loop back through table after its been updated and process it TimLeonard <TimLeonard.119b6d08@excelbanter.com> - 2016-06-06 18:27 +0100
        Re: Modify Code to loop back through table after its been updated and process it GS <gs@v.invalid> - 2016-06-06 14:42 -0400
          Re: Modify Code to loop back through table after its been updated and process it TimLeonard <TimLeonard.119bc168@excelbanter.com> - 2016-06-06 23:54 +0100
            Re: Modify Code to loop back through table after its been updated and process it GS <gs@v.invalid> - 2016-06-06 23:41 -0400
            Re: Modify Code to loop back through table after its been updated and process it GS <gs@v.invalid> - 2016-06-07 12:42 -0400
              Re: Modify Code to loop back through table after its been updated and process it TimLeonard <TimLeonard.119d5938@excelbanter.com> - 2016-06-08 05:34 +0100
                Re: Modify Code to loop back through table after its been updated and process it GS <gs@v.invalid> - 2016-06-08 03:46 -0400
                Re: Modify Code to loop back through table after its been updated and process it GS <gs@v.invalid> - 2016-06-08 13:45 -0400
                  Re: Modify Code to loop back through table after its been updated and process it GS <gs@v.invalid> - 2016-06-08 13:55 -0400
                    Re: Modify Code to loop back through table after its been updated and process it TimLeonard <TimLeonard.119e8e98@excelbanter.com> - 2016-06-09 03:45 +0100

#108880 — Modify Code to loop back through table after its been updated and process it

I have been looking for a way to expand the following code to update
some attribute block values (Tagstrings) after modifying the spreadsheet
but with no success.

What I am trying to do is, after populating the Attribute Table, update
the table with new values, then send the updated Attribute Table values
back to the attributes. I am not sure how to pull it back in to VBA and
then loop through it in order to update the attribute blocks

I really appreciate any help that can be provided. I have been
searching and working at this for days.




Code:
--------------------
    
  Sub ExtractAtts_With_Filters() 
  
  Dim Xl As Excel.Application
  Dim XlSheet As Object
  Dim XlWorkbook As Object
  
  Dim RowNum As Integer
  Dim Header As Boolean
  Dim elem As AcadEntity
  Dim Array1 As Variant
  Dim count As Integer
  Dim blk As AcadBlockReference
  
  
  '****************************************************
  'Delete the .xls Attribute Report File
  Dim KillFile As String
  varPath = ThisDrawing.Path
  
  On Error GoTo Exit_XL_App
  KillFile = varPath & "\" & "Attribute.xls"
  
  'Check that file exists
  If Len(Dir$(KillFile)) > 0 Then
  'First remove readonly attribute, if set
  SetAttr KillFile, vbNormal
  'Then delete the file
  Kill KillFile
  End If
  
  
  
  ' Launch Excel and Get Attributes***************************.
  Set Xl = New Excel.Application
  Xl.Visible = True
  
  ' Create a new workbook and find the active sheet.
  Set XlWorkbook = Xl.Workbooks.Add
  Set XlSheet = Xl.ActiveSheet
  XlWorkbook.SaveAs fileName:=varPath & "\" & "Attribute.xls", FileFormat:=1
  
  RowNum = 1
  Header = False
  
  ' Iterate through model space finding
  ' all block references.
  For Each elem In ThisDrawing.ModelSpace
  With elem
  ' When a block reference has been found,
  ' check it for attributes
  If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
  If .HasAttributes Then
  ' Get the attributes
  Array1 = .GetAttributes
  
  
  
  ' Filter through a list of attribute tagstrings in the current block.
  ' Cycle throught the list of attributes.
  For i = LBound(Array1) To UBound(Array1)
  ' Check for the correct attribute tag.
  Dim Attrib As AcadAttributeReference
  Set Attrib = Array1(i)
  ' If the Tagstring containd "Addresses" then
  ' Copy the Tagstrings into Excel
  If Attrib.TagString = "ADDRESS" Then
  
  
  
  ' Copy the Tagstrings for the
  ' Attributes into Excel
  For count = LBound(Array1) To UBound(Array1)
  If Header = False Then
  If StrComp(Array1(count).EntityName, "AcDbAttribute", 1) = 0 Then
  XlSheet.Range("A1") = "HANDLE" 'Code below adds column names
  XlSheet.Cells(RowNum, count + 2).value = Array1(count).TagString
  
  End If
  End If
  
  Next count
  
  RowNum = RowNum + 1
  For count = LBound(Array1) To UBound(Array1)
  If XlSheet.Range("A" & RowNum) = False Then
  XlSheet.Range("A" & RowNum) = "'" & "'" & elem.Handle 'Fill the columns with block data from modelspace
  End If
  XlSheet.Cells(RowNum, count + 2).value = Array1(count).TextString
  
  Next count
  
  Header = True
  End If
  Next i 'Next Filter Check
  
  End If
  End If
  End With
  Next elem
  
  Xl.Sheets("Sheet1").Cells.EntireColumn.AutoFit
  
  
  
  '************************************************************
  '   'HERE is where the code to pull updated table from access goes…
  '    Attribs(0).TextString = "THIS IS THE NEW NEW VALUE!"
  '
  '    ' Get the attributes again
  '    Dim newAttrib As Variant
  '    newAttrib = blkEntity.GetAttributes
  '
  '    ' Again, display the tags and values
  '    strAttributes = ""
  '    For i = LBound(newAttrib) To UBound(newAttrib)
  '        strAttributes = strAttributes + "  Tag: " + _
  '        newAttribs(i).TagString + vbCrLf + _
  '        "   Value: " + newAttribs(i).TextString
  '************************************************************
  
  
  'Xl.DisplayAlerts = False
  XlWorkbook.Save
  XlWorkbook.Close True '*** uncomment to keep open
  Xl.DisplayAlerts = True
  Xl.Quit
  
  Set XlSheet = Nothing
  Set XlWorkbook = Nothing
  Set Xl = Nothing
  GoTo Exit_Sub
  
  
  Exit_XL_App:
  
  MsgBox Err.Number & " - " & Err.Description & " Error occurred in Excel App Process"
  
  Xl.DisplayAlerts = False
  'XlBook.Save
  XlWorkbook.Close True '*** uncomment to keep open
  Xl.DisplayAlerts = True
  Xl.Quit
  
  Set XlSheet = Nothing
  Set XlWorkbook = Nothing
  Set Xl = Nothing
  
  Exit_Sub:
  
  End Sub
  
  
  
--------------------




-- 
TimLeonard

[toc] | [next] | [standalone]

#108881

>   Set XlSheet = Nothing
>   Set XlWorkbook = Nothing
>   Set Xl = Nothing

This is duplicate code that could be inside your Exit_Sub label 1x 
only.

You can 'dump' an entire range into a variant in 1 shot...

  Dim vAttrData

 I switched to using SolidWorks in 1998 and so I can't recall how you'd 
load an entire Acad Attribute Table into a VBA variable in 1 shot, or 
vice versa. (Seems we used a text file source, perhaps?)

To go from a worksheet to the variable...

  vAttrData = XlSheet.UsedRange

..which results a 2D array equal to the num rows/cols of data on the 
worksheet.

Similarly, you could load your Attribute Table into an array and 'dump' 
it into the worksheet in 1 shot.(Note that this needs to be a 2D array 
for all to work smoothly!)

-- 
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
  comp.lang.basic.visual.misc
  microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

[toc] | [prev] | [next] | [standalone]

#108891

Thank you for the tips, I did use it, however I still need a little help
looping through it. I tried but its not working...I need a little more
direction

Thanks again

> 
> 
> Similarly, you could load your Attribute Table into an array and 'dump'
> 
> it into the worksheet in 1 shot.(Note that this needs to be a 2D array 
> for all to work smoothly!) -- 
> 
> Not sure where in the code or how to apply this suggestion
> 
> 


Code:
--------------------
    
  Sub ExtractAtts_With_Filters()
  
  Dim Xl As Excel.Application
  Dim XlSheet As Object
  Dim XlWorkbook As Object
  
  Dim RowNum As Integer
  Dim Header As Boolean
  Dim elem As AcadEntity
  Dim Array1 As Variant
  Dim count As Integer
  'Dim blk As AcadBlockReference
  
  
  '****************************************************
  'Delete the .xls Attribute Report File
  Dim KillFile As String
  varPath = ThisDrawing.Path
  
  On Error GoTo Exit_XL_App
  KillFile = varPath & "\" & "Attribute.xls"
  
  'Check that file exists
  If Len(Dir$(KillFile)) > 0 Then
  'First remove readonly attribute, if set
  SetAttr KillFile, vbNormal
  'Then delete the file
  Kill KillFile
  End If
  
  
  
  ' Launch Excel and Get Attributes***************************.
  Set Xl = New Excel.Application
  Xl.Visible = True
  
  ' Create a new workbook and find the active sheet.
  Set XlWorkbook = Xl.Workbooks.Add
  Set XlSheet = Xl.ActiveSheet
  XlWorkbook.SaveAs fileName:=varPath & "\" & "Attribute.xls", FileFormat:=1
  
  RowNum = 1
  Header = False
  
  ' Iterate through model space finding
  ' all block references.
  For Each elem In ThisDrawing.ModelSpace
  With elem
  ' When a block reference has been found,
  ' check it for attributes
  If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
  If .HasAttributes Then
  ' Get the attributes
  Array1 = .GetAttributes
  
  
  
  ' Filter through a list of attribute tagstrings in the current block.
  ' Cycle throught the list of attributes.
  For i = LBound(Array1) To UBound(Array1)
  ' Check for the correct attribute tag.
  Dim Attrib As AcadAttributeReference
  Set Attrib = Array1(i)
  ' If the Tagstring containd "Addresses" then
  ' Copy the Tagstrings into Excel
  If Attrib.TagString = "ADDRESS" Then
  
  
  
  ' Copy the Tagstrings for the
  ' Attributes into Excel
  For count = LBound(Array1) To UBound(Array1)
  If Header = False Then
  If StrComp(Array1(count).EntityName, "AcDbAttribute", 1) = 0 Then
  XlSheet.Range("A1") = "HANDLE" 'Code below adds column names
  XlSheet.Cells(RowNum, count + 2).value = Array1(count).TagString
  
  End If
  End If
  
  Next count
  
  RowNum = RowNum + 1
  For count = LBound(Array1) To UBound(Array1)
  If XlSheet.Range("A" & RowNum) = False Then
  XlSheet.Range("A" & RowNum) = "'" & "'" & elem.Handle 'Fill the columns with block data from modelspace
  End If
  XlSheet.Cells(RowNum, count + 2).value = Array1(count).TextString
  
  Next count
  
  Header = True
  End If
  Next i 'Next Filter Check
  
  End If
  End If
  End With
  Next elem
  
  Xl.Sheets("Sheet1").Cells.EntireColumn.AutoFit
  
  
  '***********************************************************
  
  ' Code to import a field database and update the attribute table
  
  '***********************************************************
  Dim ssnew As Object
  Dim Entity As AcadEntity
  Dim blkEntity As AcadBlockReference
  Dim n As Variant        'Defaults to Variant
  
  Dim Handle As String
  Dim blockName As String
  Dim tag As String
  Dim Loops As String
  Dim Address As String
  Dim Label1 As String
  Dim Label2 As String
  Dim Device_Label As String
  Dim Extended_Label As String
  Dim Qty As String
  Dim Model_Num As String
  Dim Description As String
  Dim Vendor As String
  Dim CSFM_Num As String
  
  Dim vAttrData
  vAttrData = XlSheet.UsedRange
  
  ' Make Selection set of Blocks
  ' ----------------------------
  Set activeDoc = ThisDrawing.Application.ActiveDocument
  ThisDrawing.ActiveSpace = acModelSpace
  With activeDoc
  Set setColl = .SelectionSets
  For Each setObj In .SelectionSets
  If setObj.Name = "VBA" Then
  .SelectionSets.Item("VBA").Delete
  Exit For
  End If
  Next
  Set ssnew = activeDoc.SelectionSets.Add("VBA")
  End With
  ssnew.Select acSelectionSetAll
  
  
  ' Get Attribute values
  For Each Entity In ssnew
  
  If Entity.ObjectName = "AcDbBlockReference" Then
  Set blkEntity = Entity
  
  If blkEntity.HasAttributes Then
  Dim newAttribs As Variant
  
  newAttribs = blkEntity.GetAttributes
  
  For n = LBound(newAttribs) To UBound(newAttribs)
  
  Select Case newAttribs(n).TagString
  
  Case "HANDLE"
  Handle = newAttribs(n).TextString
  Case "BLOCKNAME"
  blockName = newAttribs(n).TextString
  Case "TAG"
  tag = newAttribs(n).TextString
  Case "LOOP"
  Loops = newAttribs(n).TextString
  Case "ADDRESS"
  Address = newAttribs(n).TextString
  Case "LABEL1"
  Label1 = newAttribs(n).TextString
  Case "LABEL2"
  Label2 = newAttribs(n).TextString
  Case "DEVICE_LABEL"
  Device_Label = newAttribs(n).TextString
  Case "EXTENDED_LABEL"
  Extended_Label = newAttribs(n).TextString
  Case "QTY"
  Qty = newAttribs(n).TextString
  Case "MODEL_NUM"
  Model_Num = newAttribs(n).TextString
  Case "DESCRIPTION"
  Description = newAttribs(n).TextString
  Case "VENDOR"
  Vendor = newAttribs(n).TextString
  Case "CSFM_NUM"
  CSFM_Num = newAttribs(n).TextString
  
  End Select
  Next n
  'Entity(n).Update 'This line does not work
  End If
  End If
  Next Entity
  
  
  '************************************************************
  
  
  Exit_XL_App:
  
  MsgBox Err.Number & " - " & Err.Description & " Error occurred in Excel App Process"
  
  Xl.DisplayAlerts = False
  'XlBook.Save
  XlWorkbook.Close True '*** uncomment to keep open
  Xl.DisplayAlerts = True
  Xl.Quit
  
  Set XlSheet = Nothing
  Set XlWorkbook = Nothing
  Set Xl = Nothing
  
  Exit_Sub:
  
  End Sub
  [\code]




-- 
TimLeonard

[toc] | [prev] | [next] | [standalone]

#108892

Just a FYI.., row/col indices are Long type NOT Integer!

Your loops are confusing to say the least. I'd have to rewrite this 
code so it's easier to read/understand. I'll post it back with 
comments...

Which loop in particular is not working?

-- 
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
  comp.lang.basic.visual.misc
  microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

[toc] | [prev] | [next] | [standalone]

#108896

'GS[_6_ Wrote: 
> ;1623706']
> Just a FYI.., row/col indices are Long type NOT Integer!
>  
Noted, I changed it

> 
> Your loops are confusing to say the least. I'd have to rewrite this 
> code so it's easier to read/understand. I'll post it back with 
> comments...
I don't know if it will help, but I had help a while back on a similar
project.
(http://excelbanter.com/showthread.php?t=450775&highlight=Modify)  
I have trouble following the logic in it and so I resort back to the
original at times when doing test modifications since I am no
programmer...
I now need to filter the Array1 to only attribute blocks that have
addresses and couldn't figure out how to add it.  Also I need to add the
ability to send the revised attribute table back in to acad blocks which
is ultimately what I am trying to code...

> 
> Which loop in particular is not working?
> 
Everything after the following doesn't update the attribute values. 
"For n = LBound(newAttribs) To UBound(newAttribs)"
It seems to run through the "n" values fine but Doesn't update the
respective .textstring.  I have been trying the "blkEntity.Update" but
it doesn't update and at some point it gives an error and closes...




-- 
TimLeonard

[toc] | [prev] | [next] | [standalone]

#108898

Yes, I recall the post. As I'm rewriting your code I find myself 
following in the same context as that 4/15 post. So here more than a 
year later we are back to the same task?

-- 
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
  comp.lang.basic.visual.misc
  microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

[toc] | [prev] | [next] | [standalone]

#108901

I'm curious as to whether or not you can simply load the attributes 
into an array and 'dump' the array into a blank worksheet like this...

  XlSheet.Cells(1).Resize(Ubound(Array1), Ubound(Array1, 2)) = Array1

..which assumes Array1 becomes a 2D array after the attributes are 
loaded into it!

-- 
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
  comp.lang.basic.visual.misc
  microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

[toc] | [prev] | [next] | [standalone]

#108905

> 
> I'm curious as to whether or not you can simply load the attributes 
> into an array and 'dump' the array into a blank worksheet like this...
> 
> XlSheet.Cells(1).Resize(Ubound(Array1), Ubound(Array1, 2)) = Array1
> 
> ...which assumes Array1 becomes a 2D array after the attributes are 
> loaded into it!
> 
I'm not exactly sure where to place it but I tried it in several
locations and  it gives an error message "Subscript out of range" in
each


However the following does array in 2D 
Dim vAttrData
vAttrData = XlSheet.UsedRange

So I been trying to figure out how to grab it and sent it back in to
autocad..  Anyways I need to do a lot more reading up on this...

Code:
--------------------
    
  For i = LBound(newAttribs) To UBound(newAttribs)
  For Count = LBound(newAttribs) + 2 To UBound(newAttribs) + 2
  If blkEntity.handle = vAttrData(Count, 1) Then
  
  Select Case newAttribs(i).TagString
  '                  Case "HANDLE"
  '                     handle = newAttr.TextString
  Case "TAG"
  newAttribs(i).TextString = vAttrData(Count, 2).TextString
  Case "LOOP"
  tmpAttr(2) = vAttrData(Count, 3).TextString
  Case "ADDRESS"
  tmpAttr(3) = vAttrData(Count, 4).TextString
  Case "LABEL1"
  tmpAttr(4) = vAttrData(Count, 5).TextString
  Case "LABEL2"
  tmpAttr(5) = vAttrData(Count, 6).TextString
  Case "DEVICE_LABEL"
  tmpAttr(6) = vAttrData(Count, 7).TextString
  Case "EXTENDED_LABEL"
  tmpAttr(7) = vAttrData(Count, 8).TextString
  Case "QTY"
  tmpAttr(8) = vAttrData(Count, 9).TextString
  Case "MODEL_NUM"
  tmpAttr(9) = vAttrData(Count, 10).TextString
  Case "DESCRIPTION"
  tmpAttr(10) = vAttrData(Count, 11).TextString
  Case "VENDOR"
  tmpAttr(11) = vAttrData(Count, 12).TextString
  Case "CSFM_NUM"
  tmpAttr(12) = vAttrData(Count, 13).TextString
  
  End Select
  End If
  Next Count
  Next i
  AttrData.Add tmpAttr   'Entity(i).Update
  End If
  End If
  Next Entity
  
--------------------




-- 
TimLeonard

[toc] | [prev] | [next] | [standalone]

#108908

If acad puts attributes into Array1 it might be worthwhile testing it's 
dims...

  Debug.Print UBound(Array1) & ":" & UBound(Array1, 2)

..to see if it's 2D. Then loop thru and list each attribute.

In any case, the acad online VBA help should tell you what you need to 
know about loading the attributes into a variant, and if it results a 
2D array!

-- 
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
  comp.lang.basic.visual.misc
  microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

[toc] | [prev] | [next] | [standalone]

#108913

This is sort of where I went using the following enum structure and 
modifying your Select Case construct as follows...

Enum acAttribs
  Handle        '0
  BlockName     '1
  Tag           '2
  Loops         '3
  Address       '4
  Label1        '5
  Label2        '6
  DeviceLabel   '7
  ExtLabel      '8
  Qty           '9
  ModelNum      '10
  Descr         '11
  Vendor        '12
  CSFM_Num      '13
End Enum

Select Case vNewAttribs(n).TagString
Case "HANDLE"
  saAttribs(acAttribs.Handle) = vNewAttribs(n).TextString
Case "BLOCKNAME"
  saAttribs(acAttribs.BlockName) = vNewAttribs(n).TextString
Case "TAG"
  saAttribs(acAttribs.Tag) = vNewAttribs(n).TextString
Case "LOOP"
  saAttribs(acAttribs.Loops) = vNewAttribs(n).TextString
Case "ADDRESS"
  saAttribs(acAttribs.Address) = vNewAttribs(n).TextString
Case "LABEL1"
  saAttribs(acAttribs.Label1) = vNewAttribs(n).TextString
Case "LABEL2"
  saAttribs(acAttribs.Label2) = vNewAttribs(n).TextString
Case "DEVICE_LABEL"
  saAttribs(acAttribs.DeviceLabel) = vNewAttribs(n).TextString
Case "EXTENDED_LABEL"
  saAttribs(acAttribs.ExtLabel) = vNewAttribs(n).TextString
Case "QTY"
  saAttribs(acAttribs.Qty) = vNewAttribs(n).TextString
Case "MODEL_NUM"
  saAttribs(acAttribs.ModelNum) = vNewAttribs(n).TextString
Case "DESCRIPTION"
  saAttribs(acAttribs.Descr) = vNewAttribs(n).TextString
Case "VENDOR"
  saAttribs(acAttribs.Vendor) = vNewAttribs(n).TextString
Case "CSFM_NUM"
  saAttribs(acAttribs.CSFM_Num) = vNewAttribs(n).TextString
End Select

-- 
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
  comp.lang.basic.visual.misc
  microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

[toc] | [prev] | [next] | [standalone]

#108914

I defined the array as follows...

  Dim saAttribs$(14) '//replaces individual vars; uses acAttribs enum

-- 
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
  comp.lang.basic.visual.misc
  microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus

[toc] | [prev] | [next] | [standalone]

#108916

> I defined the array as follows...
> 
> Dim saAttribs$(14) '//replaces individual vars; uses acAttribs enum
> 
Thanks so much for working with me.  I really appreciate it more than
you know...

I did finally write something to send the updated values back to ACAD
using following code.  I hope it is built correctly, this is a major
accomplishment for me... Pointers are appreciated...


Code:
--------------------
    
  Dim attributeObj As AcadAttribute
  Dim BlockObj As AcadBlock
  Dim Cnt As Long
  
  Dim vAttrData
  vAttrData = xlSheet.UsedRange 'Copy Data as an Array from spreadsheet
  
  'Selection Set codeE
  Cnt = 2
  For Each elem In ThisDrawing.ModelSpace
  With elem
  
  If StrComp(.EntityName, "AcDbBlockReference", 1) = 0 Then
  If elem.HasAttributes Then
  
  handle = elem.handle
  newAttribs = elem.GetAttributes
  
  '         For i = LBound(newAttribs) To UBound(newAttribs)
  For i = 0 To UBound(newAttribs)  ' For Count = LBound(newAttribs) To UBound(newAttribs) 'Read attributes from block
  Dim Attr As AcadAttributeReference
  Set Attr = newAttribs(i)
  'Filter the Tagstring that contain "Addresses" 
  If Attr.TagString = "ADDRESS" Then
  If handle = vAttrData(Cnt, 1) Then
  
  newAttribs(0).TextString = vAttrData(Cnt, 2)
  newAttribs(1).TextString = vAttrData(Cnt, 3)
  newAttribs(2).TextString = vAttrData(Cnt, 4)
  newAttribs(3).TextString = vAttrData(Cnt, 5)
  newAttribs(4).TextString = vAttrData(Cnt, 6)
  newAttribs(5).TextString = vAttrData(Cnt, 7)
  newAttribs(6).TextString = vAttrData(Cnt, 8)
  newAttribs(7).TextString = vAttrData(Cnt, 9)
  newAttribs(8).TextString = vAttrData(Cnt, 10)
  newAttribs(9).TextString = vAttrData(Cnt, 11)
  newAttribs(10).TextString = vAttrData(Cnt, 12)
  newAttribs(11).TextString = vAttrData(Cnt, 13)
  
  newAttribs(0).Update
  newAttribs(1).Update
  newAttribs(2).Update
  newAttribs(3).Update
  newAttribs(4).Update
  newAttribs(5).Update
  newAttribs(6).Update
  newAttribs(7).Update
  newAttribs(8).Update
  newAttribs(9).Update
  newAttribs(10).Update
  newAttribs(11).Update
  
  End If
  Cnt = Cnt + 1
  Exit For
  End If 'Address
  Next i
  
  End If
  End If
  End With 'elem
  Next elem
  [/code




-- 
TimLeonard

[toc] | [prev] | [standalone]

Back to top | Article view | microsoft.public.excel.programming

csiph-web