PHP User Warning: fetch_template() calls should be replaced by the vB_Template class. Template name: bbcode_highlight in ..../includes/functions.php on line 4197
[RESOLVED] Please help for remove duplicate string array and display remaining array.-VBForums
Results 1 to 18 of 18

Thread: [RESOLVED] Please help for remove duplicate string array and display remaining array.

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Aug 2007
    Posts
    211

    Resolved [RESOLVED] Please help for remove duplicate string array and display remaining array.

    Dear all expert programmers,

    I want to remove duplicate string array. I can remove duplicate but when I test with big array it is slower. Please help me to resolved this problem.

    Code:
    Option Explicit
    
    Private Sub Command1_Click()
        Dim arrTest(5) As String
        arrTest(0) = "Blue Bird"
        arrTest(1) = "White Cat"
        arrTest(2) = "White Dog"
        arrTest(4) = "Yellow Cat"
        arrTest(5) = "Green Bird"
        Call RemoveDuplicateArray(arrTest)
        'If ubound of array is 32000 it is slow. Please help me to resolved problem
    End Sub
    
    Private Sub RemoveDuplicateArray(arrSource() As String)
        Dim intLBound As Integer, intUBound As Integer
        Dim i As Integer, j As Integer, intCountDup As Integer
        Dim arrRemain() As String, strResult As String, arrTemp() As String, strTemp As String, strTempN As String
        intLBound = LBound(arrSource)
        intUBound = UBound(arrSource)
        For i = intLBound To intUBound
            If Len(arrSource(i)) > 0 Then
                arrTemp = Split(arrSource(i), " ")
                If UBound(arrTemp) = 1 Then
                    strTemp = arrTemp(0)
                    For j = i + 1 To intUBound
                        If Len(arrSource(j)) > 0 Then
                            arrTemp = Split(arrSource(j), " ")
                            If UBound(arrTemp) = 1 Then
                                strTempN = arrTemp(0)
                                If strTemp = strTempN Then
                                    arrSource(j) = vbNullString
                                    intCountDup = intCountDup + 1
                                End If
                            End If
                        End If
                    Next
                End If
            End If
        Next
        'Display Remaining array
        j = 0
        ReDim arrRemain(intUBound - intCountDup)
        For i = intLBound To intUBound
            If Len(arrSource(i)) > 0 Then
                arrRemain(j) = arrSource(i)
                j = j + 1
            End If
        Next
        Debug.Print Join(arrRemain, vbCrLf)
        
    End Sub
    Thank you for all answers.
    Last edited by standardusr; Nov 8th, 2018 at 01:32 AM.

  2. #2
    Frenzied Member ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    1,423

    Re: Please help for remove duplicate string array and display remaining array.

    Hi,

    see if this helps, I use this for Text files I get with duplicates

    I created a text File for test....
    Code:
    White Cat
    White Dog
    Blue Bird
    Yellow Cad
    Green Bird
    Green Cat
    Blue Bird
    the code ...
    Code:
    Private Sub Command2_Click()
       Dim Zeilen() As String
       Dim FileNr As Integer
       Dim i As Integer
       Dim j As Integer
       
       ' Array dimensionieren
       ReDim Zeilen(0)
       
       ' read File with Dupl.
       FileNr = FreeFile
       Open "E:\TestforDuplicate.txt" For Input As #FileNr
       Do While Not EOF(FileNr)
          ' Array anpassen
          i = i + 1
          ReDim Preserve Zeilen(i)
          Line Input #FileNr, Zeilen(i)
       Loop
       Close #FileNr
       
       ' delete Dupl.
       For i = UBound(Zeilen) To 1 Step -1
          For j = i - 1 To 1 Step -1
             If Zeilen(i) = Zeilen(j) Then
               Debug.Print Zeilen(j) 'show what was Dup.
                Zeilen(j) = ""
             End If
          Next
       Next
       
       ' write clean new File
       FileNr = FreeFile
       Open "E:\TestforDuplicate.txt" For Output As #FileNr
       For i = 1 To UBound(Zeilen)
          If Len(Zeilen(i)) > 0 Then
             Print #FileNr, Zeilen(i)
          End If
          Next
       Close #FileNr
    End Sub
    regards
    Chris
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  3. #3
    New Member
    Join Date
    Jan 2017
    Posts
    14

    Re: Please help for remove duplicate string array and display remaining array.

    String comparison is slow in VB, you can use the code of the link to obtain better results:
    http://www.xbeat.net/vbspeed/c_IsSameString.htm
    And also you may use Long variables for the loops control

  4. #4
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    873

    Re: Please help for remove duplicate string array and display remaining array.

    You can use the built-in VBA.Collection as a data-index to dedupe (on first word it seems) by trapping error 457.

    Here is a sample RemoveDuplicateArrayFast impl w/ a VBA.Collection index, based on your snippet:
    thinBasic Code:
    1. Option Explicit
    2.  
    3. Private Sub Command1_Click()
    4.     ReDim arrTest(0 To 5) As String
    5.     arrTest(0) = "Blue Bird"
    6.     arrTest(1) = "White Cat"
    7.     arrTest(2) = "White Dog"
    8.     arrTest(4) = "Yellow Cat"
    9.     arrTest(5) = "Green Bird"
    10.     Call RemoveDuplicateArray(arrTest)
    11.     'If ubound of array is 32000 it is slow. Please help me to resolved problem
    12.     arrTest(0) = "Blue Bird"
    13.     arrTest(1) = "White Cat"
    14.     arrTest(2) = "White Dog"
    15.     arrTest(4) = "Yellow Cat"
    16.     arrTest(5) = "Green Bird"
    17.     Call RemoveDuplicateArrayFast(arrTest)
    18.     Debug.Print Join(arrTest, vbCrLf)
    19. End Sub
    20.  
    21. Private Sub RemoveDuplicateArray(arrSource() As String)
    22.     Dim intLBound As Integer, intUBound As Integer
    23.     Dim i As Integer, j As Integer, intCountDup As Integer
    24.     Dim arrRemain() As String, strResult As String, arrTemp() As String, strTemp As String, strTempN As String
    25.     intLBound = LBound(arrSource)
    26.     intUBound = UBound(arrSource)
    27.     For i = intLBound To intUBound
    28.         If Len(arrSource(i)) > 0 Then
    29.             arrTemp = Split(arrSource(i), " ")
    30.             If UBound(arrTemp) = 1 Then
    31.                 strTemp = arrTemp(0)
    32.                 For j = i + 1 To intUBound
    33.                     If Len(arrSource(j)) > 0 Then
    34.                         arrTemp = Split(arrSource(j), " ")
    35.                         If UBound(arrTemp) = 1 Then
    36.                             strTempN = arrTemp(0)
    37.                             If strTemp = strTempN Then
    38.                                 arrSource(j) = vbNullString
    39.                                 intCountDup = intCountDup + 1
    40.                             End If
    41.                         End If
    42.                     End If
    43.                 Next
    44.             End If
    45.         End If
    46.     Next
    47.     'Display Remaining array
    48.     j = 0
    49.     ReDim arrRemain(intUBound - intCountDup)
    50.     For i = intLBound To intUBound
    51.         If Len(arrSource(i)) > 0 Then
    52.             arrRemain(j) = arrSource(i)
    53.             j = j + 1
    54.         End If
    55.     Next
    56.     Debug.Print Join(arrRemain, vbCrLf)
    57. End Sub
    58.  
    59. Private Sub RemoveDuplicateArrayFast(arrSource() As String)
    60.     Dim cIndex          As Collection
    61.     Dim lIdx            As Long
    62.     Dim lJdx            As Long
    63.     Dim lPos            As Long
    64.    
    65.     Set cIndex = New Collection
    66.     lJdx = LBound(arrSource)
    67.     On Error GoTo EH
    68.     For lIdx = LBound(arrSource) To UBound(arrSource)
    69.         If LenB(arrSource(lIdx)) <> 0 Then
    70.             lPos = InStr(arrSource(lIdx), " ")
    71.             If lPos > 0 Then
    72.                 cIndex.Add vbNullString, "#" & Left$(arrSource(lIdx), lPos - 1)
    73.             End If
    74.             If lJdx <> lIdx Then
    75.                 arrSource(lJdx) = arrSource(lIdx)
    76.             End If
    77.             lJdx = lJdx + 1
    78.         End If
    79. SkipDuplicate:
    80.     Next
    81.     On Error GoTo 0
    82.     If lJdx <> lIdx Then
    83.         ReDim Preserve arrSource(LBound(arrSource) To lJdx - 1) As String
    84.     End If
    85.     Exit Sub
    86. EH:
    87.     If Err.Number = 457 Then ' This key is already associated with an element of this collection
    88.         Resume SkipDuplicate
    89.     End If
    90.     Err.Raise Err.Number, Err.Source, Err.Description
    91. End Sub
    Note that arrTest(3) in sample data deliberately is an empty string.

    Note that Split is extremely slow operation and you are splitting same strings multiple times in your original impl.

    cheers,
    </wqw>

  5. #5
    PowerPoster
    Join Date
    Feb 2006
    Posts
    19,332

    Re: Please help for remove duplicate string array and display remaining array.

    32000? How slow is "slow?" How fast do you want it to be?

  6. #6
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    873

    Re: Please help for remove duplicate string array and display remaining array.

    Quote Originally Posted by dilettante View Post
    How slow is "slow?"
    I bet his impl is awefully slow as he is using double nested loops and on each of these O(N^2) steps using Split by space char to get the first "word" of a particular array index, ending up splitting the same string about N times.

    cheers,
    </wqw>

  7. #7
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,528

    Re: Please help for remove duplicate string array and display remaining array.

    The whole thing doesn't make sense to me.
    If i've understood the code correctly, he only tests the first part of each array-element (in the sample the color).
    So, somewhere in his code he reaches the stage, where he compares "white" (Element 1, the "white cat") with "white" (Element 2, the "white dog"),
    condition is true, the dog gets removed from the array.
    Why?
    "white cat" is not the same as "white dog"
    So, it's not a duplicate.
    As i said: Doesn't make sense to me!
    One System to rule them all, One IDE to find them,
    One Code to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

  8. #8
    Fanatic Member wqweto's Avatar
    Join Date
    May 2011
    Posts
    873

    Re: Please help for remove duplicate string array and display remaining array.

    Quote Originally Posted by Zvoni View Post
    "white cat" is not the same as "white dog"
    He has to have only one white animal I guess :-))

    Btw, the check involves the string containing exactly 2 words too so "white hat dog" is kept intact as the animal is not white and there is no problem with the color of its hat. . .

    cheers,
    </wqw>

  9. #9
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    3,244

    Re: Please help for remove duplicate string array and display remaining array.

    Maybe he wants the unique animal colors?

  10. #10
    PowerPoster Zvoni's Avatar
    Join Date
    Sep 2012
    Location
    To the moon and then left
    Posts
    1,528

    Re: Please help for remove duplicate string array and display remaining array.

    Quote Originally Posted by wqweto View Post
    He has to have only one white animal I guess :-))

    Btw, the check involves the string containing exactly 2 words too so "white hat dog" is kept intact as the animal is not white and there is no problem with the color of its hat. . .

    cheers,
    </wqw>
    OK, "white hat dog" and "white dog" i could agree to be a duplicate, but it still doesn't make sense to me according to his sample data.
    I've tested his code with his sample data, and the result is that the white dog gets removed as a duplicate.
    Yes, i know his question was about speed/performance, but i like to quote Joe Hacker from Bruce McKinney's "HVB":
    "The fastest code is useless, if the result is wrong"
    One System to rule them all, One IDE to find them,
    One Code to bring them all, and to the Framework bind them,
    in the Land of Redmond, where the Windows lie
    ---------------------------------------------------------------------------------
    People call me crazy because i'm jumping out of perfectly fine airplanes.
    ---------------------------------------------------------------------------------
    For health reasons i try to avoid reading unformatted Code

  11. #11
    PowerPoster
    Join Date
    Feb 2006
    Posts
    19,332

    Re: Please help for remove duplicate string array and display remaining array.

    We don't get a lot of information. For example if the resulting array needs to be in the same order as the original that eliminates or complicates a lot of possible solutions.

    For all we know "white" and "dog" are just dummy examples that mislead us into thinking this is about phrases when they might actually be separate fields and some kind of database might make more sense than a String array.

  12. #12
    PowerPoster
    Join Date
    Jun 2013
    Posts
    3,896

    Re: Please help for remove duplicate string array and display remaining array.

    Here are my two cents (using an optional Param, to allow for a leading "Split-Key")

    Code:
    Function RemoveDuplicates(Arr() As String, Optional SplDel As String)
      Dim i&, j&, P&, K$, C As New Collection
      j = LBound(Arr)
      For i = j To UBound(Arr)
        P = InStr(Arr(i), SplDel) - 1
        If P > 0 Then K = Left$(Arr(i), P) Else K = Arr(i)
        If Len(K) > 0 And Not KeyExists(C, K) Then
           C.Add 0, K
           Arr(j) = Arr(i): j = j + 1
        End If
      Next
      ReDim Preserve Arr(LBound(Arr) To j - 1)
    End Function
    
    Function KeyExists(Col As Collection, Key As String) As Boolean
    On Error GoTo ReturnFalse
        Col Key: KeyExists = True
    ReturnFalse:
    End Function
    Form_Click-TestCode (which shows two calling-variants):
    Code:
    Private Sub Form_Click()
        ReDim ArrTest(0 To 6) As String
     
        ArrTest(0) = "Blue Bird"
        ArrTest(1) = "White Cat"
        ArrTest(2) = "White Dog"
        ArrTest(4) = "Yellow Cat"
        ArrTest(5) = "Yellow Cat"
        ArrTest(6) = "Green Bird"
        
        RemoveDuplicates ArrTest 'called without SplDel removes only "Yellow Cat"
        Debug.Print Join(ArrTest, vbCrLf); vbCrLf
    
        RemoveDuplicates ArrTest, " " 'called with " " as SplDel removes "White Dog" as well
        Debug.Print Join(ArrTest, vbCrLf); vbCrLf
    End Sub
    HTH

    Olaf

  13. #13

    Thread Starter
    Addicted Member
    Join Date
    Aug 2007
    Posts
    211

    Re: Please help for remove duplicate string array and display remaining array.

    Thank you very much

  14. #14

    Thread Starter
    Addicted Member
    Join Date
    Aug 2007
    Posts
    211

    Re: Please help for remove duplicate string array and display remaining array.

    Quote Originally Posted by Arnoutdv View Post
    Maybe he wants the unique animal colors?
    I want to focus at first word only. If found duplicate first word then will select first choice only.

  15. #15

    Thread Starter
    Addicted Member
    Join Date
    Aug 2007
    Posts
    211

    Re: Please help for remove duplicate string array and display remaining array.

    Quote Originally Posted by Arnoutdv View Post
    Maybe he wants the unique animal colors?
    String array can be anything. I want to focus at first word only. If found duplicate first word then will select first choice only.

  16. #16

    Thread Starter
    Addicted Member
    Join Date
    Aug 2007
    Posts
    211

    Re: Please help for remove duplicate string array and display remaining array.

    Quote Originally Posted by Schmidt View Post
    Here are my two cents (using an optional Param, to allow for a leading "Split-Key")

    Code:
    Function RemoveDuplicates(Arr() As String, Optional SplDel As String)
      Dim i&, j&, P&, K$, C As New Collection
      j = LBound(Arr)
      For i = j To UBound(Arr)
        P = InStr(Arr(i), SplDel) - 1
        If P > 0 Then K = Left$(Arr(i), P) Else K = Arr(i)
        If Len(K) > 0 And Not KeyExists(C, K) Then
           C.Add 0, K
           Arr(j) = Arr(i): j = j + 1
        End If
      Next
      ReDim Preserve Arr(LBound(Arr) To j - 1)
    End Function
    
    Function KeyExists(Col As Collection, Key As String) As Boolean
    On Error GoTo ReturnFalse
        Col Key: KeyExists = True
    ReturnFalse:
    End Function
    Form_Click-TestCode (which shows two calling-variants):
    Code:
    Private Sub Form_Click()
        ReDim ArrTest(0 To 6) As String
     
        ArrTest(0) = "Blue Bird"
        ArrTest(1) = "White Cat"
        ArrTest(2) = "White Dog"
        ArrTest(4) = "Yellow Cat"
        ArrTest(5) = "Yellow Cat"
        ArrTest(6) = "Green Bird"
        
        RemoveDuplicates ArrTest 'called without SplDel removes only "Yellow Cat"
        Debug.Print Join(ArrTest, vbCrLf); vbCrLf
    
        RemoveDuplicates ArrTest, " " 'called with " " as SplDel removes "White Dog" as well
        Debug.Print Join(ArrTest, vbCrLf); vbCrLf
    End Sub
    HTH

    Olaf
    Thank you very much sir.

  17. #17
    PowerPoster
    Join Date
    Feb 2006
    Posts
    19,332

    Re: Please help for remove duplicate string array and display remaining array.

    Here is one built around a sort, but if you don't want the element rearranged then it may not meet your needs.

    Performance isn't too bad:

    Code:
    Option Explicit
    
    'Remove Strings with duplicate values in the first "word" (space delimited) from a String array.
    
    #Const DUMP_ELEMENTS = False
    
    Private Const ENTRIES As Long = 32000
    
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    
    Private Test() As String
    
    Private Function Deduplicate(ByRef Ary() As String) As String()
        Const CHUNK As Long = 5000
        Dim NewAry() As String
        Dim I As Long
        Dim NewI As Long
        Dim Key0 As String
        Dim Pos As Long
        Dim Key1 As String
    
        HeapsortStr.Sort Ary
        NewAry = Split(vbNullString) 'Empty valid String array.
        Do
            If UBound(NewAry) < NewI Then ReDim Preserve NewAry(NewI + CHUNK)
            NewAry(NewI) = Ary(I)
            NewI = NewI + 1
            Key0 = Ary(I)
            Pos = InStr(Key0, " ")
            If Pos Then Key0 = Left$(Key0, Pos - 1)
            I = I + 1
            Do Until I > UBound(Ary)
                Key1 = Ary(I)
                Pos = InStr(Key1, " ")
                If Pos Then Key1 = Left$(Key1, Pos - 1)
                If Key1 = Key0 Then
                    I = I + 1
                Else
                    Exit Do
                End If
            Loop
        Loop Until I > UBound(Ary)
        ReDim Preserve NewAry(NewI - 1)
        Deduplicate = NewAry
    End Function
    
    Private Sub Form_Load()
        Dim I As Long
        Dim T0 As Long
        Dim T1 As Long
    
        ReDim Test(0 To ENTRIES - 1)
        Test(0) = "Blue Bird"
        Test(1) = "White Cat"
        Test(2) = "White Dog"
        'Test(3) = vbNullString
        Test(4) = "Yellow Cat"
        Test(5) = "Green Bird"
        Test(6) = "Yellow Cat"
        Test(7) = "Zebra Lizard"
        For I = 8 To ENTRIES - 3
            Test(I) = CStr(I) & " fudd"
        Next
        Test(ENTRIES - 2) = "zebra lizard"
        Test(ENTRIES - 1) = "Blue Bird"
    
        T0 = GetTickCount()
        Test = Deduplicate(Test)
        T1 = GetTickCount()
    
        With RichTextBox1
            .SelText = Format$(ENTRIES, "#,##0")
            .SelText = " entries"
            .SelText = vbNewLine
            .SelText = Format$(UBound(Test) + 1, "#,##0")
            .SelText = " entries remaining"
            .SelText = vbNewLine
            .SelText = "Deduplicate took "
            .SelText = Format$(T1 - T0, "#,##0")
            .SelText = " ms."
            .SelText = vbNewLine
        End With
    
    #If DUMP_ELEMENTS Then
        'Defer dumping until after the Form shows:
        Timer1.Enabled = True
    #Else
        With RichTextBox1
            .SelText = vbNewLine
            .SelText = "No dump"
            .Visible = True
        End With
    #End If
    End Sub
    
    Private Sub Form_Resize()
        If WindowState <> vbMinimized Then
            RichTextBox1.Move 0, 0, ScaleWidth, ScaleHeight
        End If
    End Sub
    
    Private Sub Timer1_Timer()
        Dim I As Long
    
        Timer1.Enabled = False
        MousePointer = vbHourglass
        With RichTextBox1
            For I = 0 To UBound(Test)
                .SelText = vbNewLine
                .SelText = CStr(I)
                .SelText = vbTab
                .SelText = "= """
                .SelText = Test(I)
                .SelText = """"
            Next
            .SelStart = 0
            .Visible = True
        End With
        MousePointer = vbDefault
    End Sub
    Name:  sshot2.png
Views: 54
Size:  4.0 KB

    Name:  sshot1.png
Views: 56
Size:  1.7 KB
    Attached Files Attached Files

  18. #18

    Thread Starter
    Addicted Member
    Join Date
    Aug 2007
    Posts
    211

    Re: Please help for remove duplicate string array and display remaining array.

    Quote Originally Posted by dilettante View Post
    Here is one built around a sort, but if you don't want the element rearranged then it may not meet your needs.

    Performance isn't too bad:

    Code:
    Option Explicit
    
    'Remove Strings with duplicate values in the first "word" (space delimited) from a String array.
    
    #Const DUMP_ELEMENTS = False
    
    Private Const ENTRIES As Long = 32000
    
    Private Declare Function GetTickCount Lib "kernel32" () As Long
    
    Private Test() As String
    
    Private Function Deduplicate(ByRef Ary() As String) As String()
        Const CHUNK As Long = 5000
        Dim NewAry() As String
        Dim I As Long
        Dim NewI As Long
        Dim Key0 As String
        Dim Pos As Long
        Dim Key1 As String
    
        HeapsortStr.Sort Ary
        NewAry = Split(vbNullString) 'Empty valid String array.
        Do
            If UBound(NewAry) < NewI Then ReDim Preserve NewAry(NewI + CHUNK)
            NewAry(NewI) = Ary(I)
            NewI = NewI + 1
            Key0 = Ary(I)
            Pos = InStr(Key0, " ")
            If Pos Then Key0 = Left$(Key0, Pos - 1)
            I = I + 1
            Do Until I > UBound(Ary)
                Key1 = Ary(I)
                Pos = InStr(Key1, " ")
                If Pos Then Key1 = Left$(Key1, Pos - 1)
                If Key1 = Key0 Then
                    I = I + 1
                Else
                    Exit Do
                End If
            Loop
        Loop Until I > UBound(Ary)
        ReDim Preserve NewAry(NewI - 1)
        Deduplicate = NewAry
    End Function
    
    Private Sub Form_Load()
        Dim I As Long
        Dim T0 As Long
        Dim T1 As Long
    
        ReDim Test(0 To ENTRIES - 1)
        Test(0) = "Blue Bird"
        Test(1) = "White Cat"
        Test(2) = "White Dog"
        'Test(3) = vbNullString
        Test(4) = "Yellow Cat"
        Test(5) = "Green Bird"
        Test(6) = "Yellow Cat"
        Test(7) = "Zebra Lizard"
        For I = 8 To ENTRIES - 3
            Test(I) = CStr(I) & " fudd"
        Next
        Test(ENTRIES - 2) = "zebra lizard"
        Test(ENTRIES - 1) = "Blue Bird"
    
        T0 = GetTickCount()
        Test = Deduplicate(Test)
        T1 = GetTickCount()
    
        With RichTextBox1
            .SelText = Format$(ENTRIES, "#,##0")
            .SelText = " entries"
            .SelText = vbNewLine
            .SelText = Format$(UBound(Test) + 1, "#,##0")
            .SelText = " entries remaining"
            .SelText = vbNewLine
            .SelText = "Deduplicate took "
            .SelText = Format$(T1 - T0, "#,##0")
            .SelText = " ms."
            .SelText = vbNewLine
        End With
    
    #If DUMP_ELEMENTS Then
        'Defer dumping until after the Form shows:
        Timer1.Enabled = True
    #Else
        With RichTextBox1
            .SelText = vbNewLine
            .SelText = "No dump"
            .Visible = True
        End With
    #End If
    End Sub
    
    Private Sub Form_Resize()
        If WindowState <> vbMinimized Then
            RichTextBox1.Move 0, 0, ScaleWidth, ScaleHeight
        End If
    End Sub
    
    Private Sub Timer1_Timer()
        Dim I As Long
    
        Timer1.Enabled = False
        MousePointer = vbHourglass
        With RichTextBox1
            For I = 0 To UBound(Test)
                .SelText = vbNewLine
                .SelText = CStr(I)
                .SelText = vbTab
                .SelText = "= """
                .SelText = Test(I)
                .SelText = """"
            Next
            .SelStart = 0
            .Visible = True
        End With
        MousePointer = vbDefault
    End Sub
    Name:  sshot2.png
Views: 54
Size:  4.0 KB

    Name:  sshot1.png
Views: 56
Size:  1.7 KB
    Thank you for you help sir.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width