[resolved] Please help with VBA, for Excel 2007: working with objects-VBForums
Results 1 to 23 of 23

Thread: [resolved] Please help with VBA, for Excel 2007: working with objects

  1. #1

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Resolved [resolved] Please help with VBA, for Excel 2007: working with objects

    Hi, I have attempted to create a code for the following described purpose, but my codes do not produce my desired results. Without reallizing the difference between VB.NET and VBA, I had a thread over at the VB.NET forum.
    My version of VBA is: "Microsoft Visual Basic 6.5", VBA: Retail 6.5.1053


    I am attempting to create a program to take account of several cells in a column like so (example):
    123
    234
    123
    123
    345
    005
    007
    123

    1. filter out any 005, 007, 006, and 009 values,

    2. then store everything else into an array without repetition, so the array would now be:
    123
    234
    345

    3. then convert integers to strings
    4. lastly combine the strings
    5. and output the combined string:
    "123, 234, 345"

    My codes are:
    Code:
    Public Function CollectSources(Sheetname As String, CellCol As Integer, CellRow As Integer, SelectLength As Integer) As String
    
    ' This is a non-coded note
    ' input asks for Sheetname, the initial cell position (CellCol, CellRow), and the number of cells to account for (including initial cell)
    ' Dim = command to set variable type
    Dim CellRowNow, CurrVal As Integer ' CellRowNow is the current position of Cell row, CurrVal is the value of the current cell
    Dim SourceArray(), ArrayLength, ArrayPosition As Integer ' SourceArray(ArrayPosition) is the value of the current array variable
    Dim NoSimilar As Boolean ' NoSimilar is whether the CurrVal is the same value as any numbers already stored in SourceArray()
    Dim result, StringTemp As String ' result is the accumulating string of numbers, StringTemp is used to store string converted from integer
    
    ArrayLength = 0
    
        Do While SelectLength > 0
            ' loops for "SelectLength" numbers of times
            SelectLength = SelectLength - 1 ' if initial cell at (1,1) w/ SelectLength of 2, then first processed position is at (1,2) when SelectLength should now be 1 (2-1=1), second position (which is the initial cell at (CellCol, CellRow)) is at (1,1) when SelectLength is 0 (1-1=0)
            CellRowNow = CellRow + SelectLength ' sets current cell row, and current cell column never changes
            CurrVal = Worksheets(Sheetname).Cells(CellCol, CellRowNow).value ' gets current cell value from current position
            ' ---------------
            If CurrVal <> 5 Or CurrVal <> 6 Or CurrVal <> 7 Or CurrVal <> 9 Then
                ' if CurrVal does not equal 5, 6, 7, or 9
                ' ---------------
                If ArrayLength > 0 Then
                    ' if not first value in array
                    ArrayPosition = 0 ' reset array position
                    NoSimilar = False
                    ' ---------------
                    Do While ArrayPosition < ArrayLength
                        ' loops for "ArrayLength" numbers of times
                        If SourceArray(ArrayPosition) = Worksheets(Sheetname).Cells(CellCol, CellRowNow).value Then
                            ' if current cell value equal any of array values
                            NoSimilar = False ' not similar is not true
                            Exit Do ' thus exit loop
                        End If
                        NoSimilar = True ' if still in loop then there hasn't been match between cell value and array value
                        ArrayPosition = ArrayPosition + 1 ' advance to next array position
                    Loop
                    ' ---------------
                    ' ---------------
                    If NoSimilar = True Then
                        ReDim Preserve SourceArray(0 To ArrayPosition) ' ArrayPosition numerically 1 less than ArrayLength to account for 0
                        SourceArray(ArrayPosition) = Worksheets(Sheetname).Cells(CellCol, CellRowNow).value ' insert current value into current array slot
                        ArrayLength = ArrayLength + 1 ' increase record of array length
                    Else
                        ' If NoSimilar = False, then nothing happens here
                    End If
                    ' ---------------
                ElseIf ArrayLength = 0 Then
                    ' if first value in array
                    ReDim SourceArray(0) ' initialize first array slot
                    SourceArray(0) = Worksheets(Sheetname).Cells(CellCol, CellRowNow).value ' insert value into first array slot
                    ArrayLength = 1 ' set array length to 1
                Else
                    result = "Error" ' impossible case where ArrayLength value is absent or < 0
                End If
                ' ---------------
            Else
                ' If CurrVal does equal 5, 6, 7, or 9, then nothing happens here
            End If
            ' ---------------
            If result = "Error" Then
                Exit Do ' exit loop if there is an error
            End If
        Loop
        
        ArrayPosition = 0
        Do While ArrayPosition < ArrayLength
            StringTemp = str(SourceArray(ArrayPosition))
            result = result + ", " + StringTemp
            ArrayPosition = ArrayPosition + 1
        Loop
        CollectSources = result
    End Function
    There are no error messages from my codes, but it does not do as it is intended.
    Currently, it displays: ", 0"
    no matter what data was given.

    Kevininstructor kindly revamped my entire code into the following .NET code:
    Code:
    Private Sub GetDistinctValues()
        Using cn As New System.Data.OleDb.OleDbConnection
            ' Change to your worksheet
            Using cmd As OleDbCommand = New OleDbCommand With _
            { _
                    .Connection = cn, _
                    .CommandText = "SELECT DISTINCT F1 FROM [Sheet1$] " _
            }
                ' Change to use your file
                Dim FileName As String = IO.Path.Combine(Application.StartupPath, "book1.xlsx")
                ' Change if not using Excel 2007
                Dim Builder As New OleDbConnectionStringBuilder With _
                    { _
                        .DataSource = FileName, _
                        .Provider = "Microsoft.ACE.OLEDB.12.0" _
                    }
                ' Change if not using Excel 2007
                Builder.Add("Extended Properties", "Excel 12.0; HDR=No;")
    
                cn.ConnectionString = Builder.ConnectionString
                cn.Open()
    
                Dim dt As New DataTable
                dt.Load (cmd.ExecuteReader)
                Dim Result = String.Join(",", _
                ( _
                    From T In dt.AsEnumerable _
                    Select Value = CStr(T.Field(Of Integer)("F1"))).ToArray _
                )
    
                Console.WriteLine (result)
            End Using
        End Using
    End Sub
    Which led to my reallization that VB.NET is entirely incompatible with VBA.

    Thanks to anyone for taking a look at this.
    Last edited by needhelpooo; Feb 24th, 2012 at 08:54 AM.

  2. #2
    Frenzied Member
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    1,695

    Re: Please help with VBA, 6.5 for Excel

    Try this simplified code
    vb Code:
    1. Public Function CollectSources(Sheetname As String, CellCol As Integer, CellRow As Integer, SelectLength As Integer) As String
    2.  
    3.     Dim colUnique As Collection
    4.     Dim lngCurrVal As Long
    5.     Dim j As Long
    6.     Dim strResult As String
    7.    
    8.     On Error Resume Next
    9.    
    10.     Set colUnique = New Collection
    11.    
    12.     For j = 0 To SelectLength - 1
    13.         lngCurrVal = CLng(Worksheets(Sheetname).Cells(CellRow + j, CellCol).Value)
    14.         If lngCurrVal <> 5 And lngCurrVal <> 6 And lngCurrVal <> 7 And lngCurrVal <> 9 Then
    15.             colUnique.Add lngCurrVal, "k" & lngCurrVal ' Trying to add the same value with the same key will cause an error and nothing will added, by this way we ensure no value will repeated
    16.                                                              ' I start the key with "k" because a key must be a string type
    17.         End If
    18.     Next
    19.    
    20.     For j = 1 To colUnique.Count
    21.         strResult = strResult & colUnique.Item(j) & ", "
    22.     Next
    23.    
    24.     CollectSources = Mid$(strResult, 1, Len(strResult) - 2) ' remove the last comma
    25.    
    26. End Function

    If you need more description about the code, just ask.

  3. #3
    Super Moderator Hack's Avatar
    Join Date
    Aug 2001
    Location
    Searching for mendhak
    Posts
    58,335

    Re: Please help with VBA, 6.5 for Excel

    VBA is also not VB6....although they are closer in syntax than VB6 and VB.NET there are still things in VB6 that will not work in VBA.

    VBA questions are posted in the Office Development section and that is where I have moved your thread.

    I have deleted the other one.
    Please use [Code]your code goes in here[/Code] tags when posting code.
    When you have received an answer to your question, please mark it as resolved using the Thread Tools menu.
    Before posting your question, did you look here?
    Got a question on Linux? Visit our Linux sister site.
    I dont answer coding questions via PM or EMail. Please post a thread in the appropriate forum section.

    Creating A Wizard In VB.NET
    Paging A Recordset
    What is wrong with using On Error Resume Next
    Good Article: Language Enhancements In Visual Basic 2010
    Upgrading VB6 Code To VB.NET
    Microsoft MVP 2005/2006/2007/2008/2009/2010/2011/2012/Defrocked

  4. #4

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, 6.5 for Excel

    Thank you very much for your help, it worked perfectly for my purpose. I'll attempt to understand what I can, and be sure to follow with questions.

    Thank you again!

  5. #5

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, 6.5 for Excel

    Could you tell me what the dollar sign amidst of the Mid function at line 24 signifies? Thanks!

    I did not previously reallize that the number of each unique value would have to be kept... To my understanding, this is also achieved by object oriented programming with objects having properties such as name and amount. However I am thus far unable to wrap my head around how to actually do it.

    Would anyone be so kind to help me again in this matter? Thank you.

    Example:
    From (values in cells in a column formation):
    123
    234
    123
    123
    345
    345
    005
    007
    123

    Output:
    "123 (4), 234 (1), 345 (2)"

  6. #6
    Frenzied Member
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    1,695

    Re: Please help with VBA, 6.5 for Excel

    Quote Originally Posted by needhelpooo View Post
    Could you tell me what the dollar sign amidst of the Mid function at line 24 signifies? Thanks!
    Mid$ return the result as string type
    while Mid return the result as object type
    therefore Mid$ is recommended for speed purpose.

    Quote Originally Posted by needhelpooo View Post
    Would anyone be so kind to help me again in this matter?
    I'm here again

    The new output requirement needs to change the implementation because using Collection as before will make it much difficult.
    I have commented the code as possible as i can to make it clear.

    vb Code:
    1. Public Function CollectSources(Sheetname As String, CellCol As Integer, CellRow As Integer, SelectLength As Integer) As String
    2.  
    3.     Dim strValues() As String
    4.     Dim lngCurrVal As Long
    5.     Dim j As Long
    6.     Dim k As Long
    7.     Dim n As Long
    8.     Dim b As Long
    9.     Dim strResult As String
    10.    
    11.    
    12.     ' Get values
    13.     For j = 0 To SelectLength - 1
    14.         lngCurrVal = CLng(Worksheets(Sheetname).Cells(CellRow + j, CellCol).Value)
    15.         If lngCurrVal <> 5 And lngCurrVal <> 6 And lngCurrVal <> 7 And lngCurrVal <> 9 Then
    16.             ReDim Preserve strValues(n)
    17.             strValues(n) = lngCurrVal
    18.             n = n + 1
    19.         End If
    20.     Next
    21.    
    22.     b = UBound(strValues) ' for speed purpose, cache UBound(strValues) in a variable instead of continuesly calculating it inside the loop
    23.    
    24.     ' Search for repeated values and add its count after it
    25.     For j = 0 To b - 1
    26.         If strValues(j) <> vbNullString Then
    27.             n = 1
    28.             For k = j + 1 To b
    29.                 If strValues(j) = strValues(k) Then
    30.                     n = n + 1
    31.                     strValues(k) = vbNullString ' delete the repeated value in order to not find it again.
    32.                 End If
    33.             Next
    34.             strValues(j) = strValues(j) & " (" & n & ")" ' append the value count
    35.         End If
    36.     Next
    37.    
    38.     For j = 0 To b
    39.         If strValues(j) <> vbNullString Then
    40.             strResult = strResult & strValues(j) & ", "
    41.         End If
    42.     Next
    43.    
    44.     CollectSources = Mid$(strResult, 1, Len(strResult) - 2) ' remove the last comma
    45. End Function

  7. #7

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, for Excel 2007: working with objects

    Thank you very much!

    Again, that is exactly what I need for my data organization. I'll take some time to learn these codes then return with questions for anything I couldn't understand.

    Thanks again!

  8. #8

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, for Excel 2007: working with objects

    Hi again, I've noticed that when at the end of the output list, if there is only one of the item at the end it doesn't show the (#) part, example:

    For:
    123
    123
    345
    345
    The output would be:
    123 (2), 345 (2)

    While for:
    123
    123
    345
    The output would be:
    123 (2), 345
    I would like this format:
    123 (2), 345 (1)

    I'm writing a follow up program for the next step, which would require the data to be in the "345 (1)" format (I'm not yet good enough to work around things). While I gained some understanding to each of your lines, I couldn't figure out why it's omitting the "(1)" at the end. Could you help me again?

    Thank you!




    The following code is the follow-up program, which requires the specific formatting for its inputs. Couldn't have been able to write it without your help.

    Code:
    Function reCollectSources(Sheetname As String, CellCol As Integer, CellRow As Integer, SelectLength As Integer) As String
    Dim colUnique As Collection
    Dim currElementAmount As Long
    Dim j As Long
    Dim k As Long
    Dim n As Long
    Dim b As Long
    Dim x As Variant
    Dim y As Variant
    Dim strValues() As String
    Dim strResult As String
    Dim allStrings As String
    Dim extElement As String
    Dim currElement As String
    
    ' 1. Collect strings into allStrings
    For j = 0 To SelectLength - 1
        allStrings = allStrings & CStr(Worksheets(Sheetname).Cells(CellRow, CellCol + j).value) & ", "
    Next
    
    ' 2. Insert uniques from extracted elements of the single string into collection object
        ' extract entire elements
        x = Split(allStrings, "), ")
        For j = 0 To UBound(x) - 1
            extElement = x(j)
            ' separate value and amount in each element
            y = Split(extElement, " (")
            currElement = CStr(y(0))
            currElementAmount = CLng(y(1))
            
    ' 3. Reconstitute into array: strValues()
            For k = 1 To currElementAmount
                ReDim Preserve strValues(n)
                strValues(n) = currElement
                n = n + 1
                ' ''' vestigial code: strResult = strResult & currElement & ", "
            Next
        Next
    
    ' 4. Recount
            b = UBound(strValues)
     ' for speed purpose, cache UBound(strValues) in a variable instead of continuesly calculating it inside the loop
            ' Search for repeated values and add its count after it
        For j = 0 To b - 1
            If strValues(j) <> vbNullString Then
                n = 1
                For k = j + 1 To b
                    If strValues(j) = strValues(k) Then
                        n = n + 1
                        strValues(k) = vbNullString ' delete the repeated value in order to not find it again.
                    End If
                Next
                strValues(j) = strValues(j) & " (" & n & ")" ' append the value count
            End If
        Next
        
        For j = 0 To b
            If strValues(j) <> vbNullString Then
                strResult = strResult & strValues(j) & ", "
            End If
        Next
    
    
    reCollectSources = Mid$(strResult, 1, Len(strResult) - 2)
    End Function
    What it does is that it takes inputs (listed in a column):
    123 (2), 234(3), 345 (1)
    234 (4), 345 (1)
    123 (1), 345 (4)
    And sums it up to:
    123 (3), 234 (7), 345 (6)
    And it's functional as long as the inputs are in the required format of "345 (1)".
    Last edited by needhelpooo; Feb 6th, 2012 at 11:28 AM.

  9. #9
    Frenzied Member
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    1,695

    Re: Please help with VBA, for Excel 2007: working with objects

    The solution is simple, just replace the line #25
    vb Code:
    1. ' Search for repeated values and add its count after it
    2.     For j = 0 To b - 1
    with
    vb Code:
    1. ' Search for repeated values and add its count after it
    2.     For j = 0 To b

  10. #10

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, for Excel 2007: working with objects

    That's perfect, thanks!

    I'm also wondering about how to improve the codes I wrote so that it would display the list of numbers in a sorted manner according to the amount it appears in the array where the data was drawn from.

    example:
    What my codes in previous post does (listed in a column):
    123 (2), 234(3), 345 (1)
    234 (4), 345 (1)
    123 (1), 345 (4)
    Internally it converts it into an array that is a mixture that contains 3 of "123", 7 of "234", and 6 of "345".
    And then outputs:
    123 (3), 234 (7), 345 (6)
    Would be great if its output could be sorted as such:
    234 (7), 345 (6), 123 (3)
    P.S. Is there a name to this type of sorting in computer science?

    Could you help me with this again? Thank you so much!
    Last edited by needhelpooo; Feb 6th, 2012 at 01:55 PM.

  11. #11
    Frenzied Member
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    1,695

    Re: Please help with VBA, for Excel 2007: working with objects

    Here you are, the previous code is not changed, i just added new sub to sort values according their count.

    vb Code:
    1. Public Function CollectSources(Sheetname As String, CellCol As Integer, CellRow As Integer, SelectLength As Integer) As String
    2.  
    3.     Dim strValues() As String
    4.     Dim lngCurrVal As Long
    5.     Dim j As Long
    6.     Dim k As Long
    7.     Dim n As Long
    8.     Dim b As Long
    9.     Dim strResult As String
    10.    
    11.    
    12.     ' Get values
    13.     For j = 0 To SelectLength - 1
    14.         lngCurrVal = CLng(Worksheets(Sheetname).Cells(CellRow + j, CellCol).Value)
    15.         If lngCurrVal <> 5 And lngCurrVal <> 6 And lngCurrVal <> 7 And lngCurrVal <> 9 Then
    16.             ReDim Preserve strValues(n)
    17.             strValues(n) = lngCurrVal
    18.             n = n + 1
    19.         End If
    20.     Next
    21.    
    22.     b = UBound(strValues) ' cache UBound(strValues) in a variable instead of continuesly calculating it inside the loop
    23.    
    24.     ' Search for repeated values and add its count after it
    25.     For j = 0 To b
    26.         If strValues(j) <> vbNullString Then
    27.             n = 1
    28.             For k = j + 1 To b
    29.                 If strValues(j) = strValues(k) Then
    30.                     n = n + 1
    31.                     strValues(k) = vbNullString ' delete the repeated value in order to not find it again.
    32.                 End If
    33.             Next
    34.             strValues(j) = strValues(j) & " (" & n & ")" ' append value count
    35.         End If
    36.     Next
    37.    
    38.     SortValuesCount strValues
    39.    
    40.     For j = 0 To b
    41.         If strValues(j) <> vbNullString Then
    42.             strResult = strResult & strValues(j) & ", "
    43.         End If
    44.     Next
    45.    
    46.     CollectSources = Mid$(strResult, 1, Len(strResult) - 2) ' remove the last comma
    47. End Function
    48.  
    49. Private Sub SortValuesCount(ByRef v() As String)
    50.     Dim j As Long
    51.     Dim k As Long
    52.     Dim b As Long
    53.     Dim x As Long
    54.     Dim y As Long
    55.     Dim z As String
    56.    
    57.    
    58.     b = UBound(v)
    59.    
    60.     For j = 0 To b
    61.         If v(j) <> vbNullString Then
    62.             x = Val(Mid$(v(j), InStr(1, v(j), "(") + 1)) ' get the count
    63.             For k = j + 1 To b
    64.                 If v(k) <> vbNullString Then
    65.                     y = Val(Mid$(v(k), InStr(1, v(k), "(") + 1)) ' get the count
    66.                     If x < y Then ' compare the two count and swap if x < y
    67.                         z = v(j)
    68.                         v(j) = v(k)
    69.                         v(k) = z
    70.                     End If
    71.                 End If
    72.             Next
    73.         End If
    74.     Next
    75.  
    76. End Sub

  12. #12

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, for Excel 2007: working with objects

    Once again, thank you so much for your help! The sorting algorithm is great

  13. #13
    Frenzied Member
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    1,695

    Re: Please help with VBA, for Excel 2007: working with objects

    Well,
    Last edited by 4x2y; Feb 7th, 2012 at 11:03 PM.

  14. #14

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, for Excel 2007: working with objects

    Already have!
    I'm stuck with it asking me to "spread it around" first, and I won't forget about rating the rest of your posts. You have really helped me very generously.

  15. #15
    Frenzied Member
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    1,695

    Re: Please help with VBA, for Excel 2007: working with objects

    Quote Originally Posted by needhelpooo View Post
    Already have!
    Thanks, indeed after posting, i discovered that you actually rate my solution, therefore i have edited the last post.

  16. #16

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, for Excel 2007: working with objects

    I had a question below, but after taking a nice walk, it came to me of why it happened as well as the solution.

    By adding a while loop to repeat the sorting when a switch between numbers happen.

    vb Code:
    1. Private Sub SortValuesCount(ByRef v() As String)
    2.     Dim j As Long
    3.     Dim k As Long
    4.     Dim b As Long
    5.     Dim x As Long
    6.     Dim y As Long
    7.     Dim z As String
    8.    
    9.     b = UBound(v)
    10.     i = 1
    11.     Do While i = 1
    12.         i = 0
    13.         For j = 0 To b
    14.             If v(j) <> vbNullString Then
    15.                 x = Val(Mid$(v(j), InStr(1, v(j), "(") + 1)) ' get the count
    16.                 For k = j + 1 To b
    17.                     If v(k) <> vbNullString Then
    18.                         y = Val(Mid$(v(k), InStr(1, v(k), "(") + 1)) ' get the count
    19.                         If x < y Then ' compare the two count and swap if x < y
    20.                             z = v(j)
    21.                             v(j) = v(k)
    22.                             v(k) = z
    23.                             i = 1
    24.                         End If
    25.                     End If
    26.                 Next
    27.             End If
    28.         Next
    29.     Loop
    30.  End Sub
    And out of curiosity, is there any better way of going about this? Thanks.

    P.S.
    Apparently it still doesn't sort things with parenthesis well:
    example input:
    Some string here (Stuff in parenthesis) (1)
    Another string (Stuff in parenthesis) (3)

    =============================================================================
    After application to a large set of data, I noticed some stragglers didn't sort as expected.:

    example 1:
    input was:
    810 (5), 6 (16), 811 (3), 800 (3), 831 (2), 5 (1)
    5 (1), 800 (4), 6 (28)
    6 (11)
    800 (1), 6 (29), 5 (2), 811 (1)
    6 (23), 810 (1)

    output was:
    800 (8), 6 (107), 810 (6), 811 (4), 5 (4), 831 (2)

    example 2:
    input was:
    810 (1), 6 (29)
    5 (1), 6 (32)
    6 (11)
    6 (31), 831 (1), 800 (1)
    6 (23), 831 (1)

    output was:
    831 (2), 6 (126), 5 (1), 810 (1), 800 (1)

    To recap the codes involved, it is the one I wrote with the insertion of the sorting sub you created:
    vb Code:
    1. Function reCollectSources(Sheetname As String, CellCol As Integer, CellRow As Integer, SelectLength As Integer) As String
    2. Dim colUnique As Collection
    3. Dim currElementAmount As Long
    4. Dim j As Long
    5. Dim k As Long
    6. Dim n As Long
    7. Dim b As Long
    8. Dim x As Variant
    9. Dim y As Variant
    10. Dim strValues() As String
    11. Dim strResult As String
    12. Dim allStrings As String
    13. Dim extElement As String
    14. Dim currElement As String
    15.  
    16. ' 1. Collect strings into allStrings
    17. For j = 0 To SelectLength - 1
    18.     allStrings = allStrings & CStr(Worksheets(Sheetname).Cells(CellRow, CellCol + j).value) & ", "
    19. Next
    20.  
    21. ' 2. Insert uniques from extracted elements of the single string into collection object
    22.     ' extract entire elements
    23.     x = Split(allStrings, "), ")
    24.     For j = 0 To UBound(x) - 1
    25.         extElement = x(j)
    26.         ' separate value and amount in each element
    27.         y = Split(extElement, " (")
    28.         currElement = CStr(y(0))
    29.  
    30.         currElementAmount = CLng(y(1))
    31.        
    32. ' 3. Reconstitute into array: strValues()
    33.         For k = 1 To currElementAmount
    34.             ReDim Preserve strValues(n)
    35.             strValues(n) = currElement
    36.             n = n + 1
    37.             ' ''' vestigial code: strResult = strResult & currElement & ", "
    38.         Next
    39.     Next
    40.    
    41. ' 4. Recount
    42.         b = UBound(strValues)
    43.  ' for speed purpose, cache UBound(strValues) in a variable instead of continuesly calculating it inside the loop
    44.         ' Search for repeated values and add its count after it
    45.     For j = 0 To b ' -1
    46.         If strValues(j) <> vbNullString Then
    47.             n = 1
    48.             For k = j + 1 To b
    49.                 If strValues(j) = strValues(k) Then
    50.                     n = n + 1
    51.                     strValues(k) = vbNullString ' delete the repeated value in order to not find it again.
    52.                 End If
    53.             Next
    54.             strValues(j) = strValues(j) & " (" & n & ")" ' append the value count
    55.         End If
    56.     Next
    57.    
    58.     SortValuesCount strValues
    59.    
    60.     For j = 0 To b
    61.         If strValues(j) <> vbNullString Then
    62.             strResult = strResult & strValues(j) & ", "
    63.         End If
    64.     Next
    65.  
    66.  
    67. reCollectSources = Mid$(strResult, 1, Len(strResult) - 2)
    68. End Function
    69.  
    70. Private Sub SortValuesCount(ByRef v() As String)
    71.     Dim j As Long
    72.     Dim k As Long
    73.     Dim b As Long
    74.     Dim x As Long
    75.     Dim y As Long
    76.     Dim z As String
    77.    
    78.     b = UBound(v)
    79.     For j = 0 To b
    80.         If v(j) <> vbNullString Then
    81.             x = Val(Mid$(v(j), InStr(1, v(j), "(") + 1)) ' get the count
    82.             For k = j + 1 To b
    83.                 If v(k) <> vbNullString Then
    84.                     y = Val(Mid$(v(k), InStr(1, v(k), "(") + 1)) ' get the count
    85.                     If x < y Then ' compare the two count and swap if x < y
    86.                         z = v(j)
    87.                         v(j) = v(k)
    88.                         v(k) = z
    89.                     End If
    90.                 End If
    91.             Next
    92.         End If
    93.     Next
    94.  End Sub

    Before I noticed the problem, I made another sub addition. The addition seems to further interfere with the sorting process...

    Input was:
    812 (20), 810 (1), 6 (9)
    6 (19), 800 (1), 812 (13)
    813 (1), 812 (8), 6 (2)
    6 (26), 812 (7) 6 (19), 812 (5)

    Output was:
    6 (75), 812 (53), 810 (1), 800 (1), 813 (1)

    After adding a sub here:
    Line 28: currElement = CStr(y(0))
    Line 29: ConvertSourceNamesHere currElement ' the added sub
    Line 30: currElementAmount = CLng(y(1))

    ...
    The sub:
    vb Code:
    1. Private Sub ConvertSourceNamesHere(ByRef v As String)
    2. Dim j As Long
    3. Dim x As Long
    4. Dim result As String
    5.  
    6.  
    7.         x = CLng(v)
    8.         Select Case x
    9.  
    10.             Case 6
    11.             result = "ALL CAPS"
    12.  
    13.             Case 830
    14.             result = "String (And in parenthesis)"
    15.            
    16.             Case 810
    17.             result = "Some string here (And in parenthesis)"
    18.  
    19.             Case 812
    20.             result = "Test"
    21.                
    22.             Case 813
    23.             result = "Second test"
    24.  
    25.             Case Else
    26.             result = v
    27.            
    28.            
    29.         End Select
    30.         v = result
    31. End Sub

    After the addition of the sub, the output becomes out of order:
    ALL CAPS (75), Second test (1), 800 (1), Test (53), Some string here (And in parenthesis) (1)

    Thank you very much for any insights on this.
    Last edited by needhelpooo; Feb 9th, 2012 at 11:03 AM.

  17. #17
    Frenzied Member
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    1,695

    Re: Please help with VBA, for Excel 2007: working with objects

    By adding a while loop to repeat the sorting when a switch between numbers happen.
    There is no need at all to repeat sorting when swap two values.

    Apparently it still doesn't sort things with parenthesis well:
    I was think you are deal with numeric values only, anyway a little change to the sort method will make it work with data includes "(" by using InstrRev instead of Instr
    vb Code:
    1. Private Sub SortValuesCount(ByRef v() As String)
    2.     Dim j As Long
    3.     Dim k As Long
    4.     Dim b As Long
    5.     Dim x As Long
    6.     Dim y As Long
    7.     Dim z As String
    8.    
    9.    
    10.     b = UBound(v)
    11.    
    12.     For j = 0 To b
    13.         If v(j) <> vbNullString Then
    14.             x = Val(Mid$(v(j), InStrRev(v(j), "(") + 1))   ' get the count
    15.             For k = j + 1 To b
    16.                 If v(k) <> vbNullString Then
    17.                     y = Val(Mid$(v(k), InStrRev(v(k), "(") + 1))  ' get the count
    18.                     If x < y Then ' compare the two count and swap if x < y
    19.                         z = v(j)
    20.                         v(j) = v(k)
    21.                         v(k) = z
    22.                     End If
    23.                 End If
    24.             Next
    25.         End If
    26.     Next
    27.  
    28. End Sub

    I hope this solve other issues.

  18. #18

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, for Excel 2007: working with objects

    Thank you again for your help!

    I was think you are deal with numeric values only
    I wish I could've known that earlier too, wasn't able to reallize that was needed until the issue came up during the process.

    I will be able to try out the new codes next week, thanks again!
    Last edited by needhelpooo; Feb 10th, 2012 at 01:03 PM.

  19. #19

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, for Excel 2007: working with objects

    Thanks 4x2y, the code is working perfectly with the edit, and I was able to understand it as well.

    I have been looking for a way to get a cell's position without any success, could anyone help?

    Example:
    =Function(C56)
    displays:
    3,56

    Thank you!
    Last edited by needhelpooo; Feb 16th, 2012 at 10:30 AM.

  20. #20
    Frenzied Member
    Join Date
    Nov 2010
    Posts
    1,197

    Re: Please help with VBA, for Excel 2007: working with objects

    if you want "c" instead of 3 there are a plethora of program snippets all over the weba dn in this form to do just that!..

    an easy less programmatic way is to use what you have and ask a simple question...

    I have been talking lately on this forum about knowing the odd things about your languages and how importand it is..

    well for your problem look at how you use row and column your 56 and 3 from above..

    sometimes its c56 sometimes it 56,3

    the row is always a number its the column that causes an issue

    you can get the column back using a number of functions but they all return numbers

    so people have reverted to writting large programs to work out the column number to letter(s) value

    BUT you get the column back as letters if you ask for the address and you can parse the address for the column letters

    like this letters=cells(56,3).address this returns $c$56 and then you have to collect the stuff after the first $ upto the second $ easy

    but did you realise that you can ask for just the column bit...

    letters=cells(3).address this returns $c$1 and you can get the stuff as before

    i would not use this as a way of shortening access to the first row of a column. The row portion retruns a predictable, but worthless value, unless you know different?

    hope that helps

  21. #21
    Frenzied Member
    Join Date
    Sep 2006
    Location
    Egypt
    Posts
    1,695

    Re: Please help with VBA, for Excel 2007: working with objects

    Quote Originally Posted by needhelpooo View Post
    I have been looking for a way to get a cell's position without any success, could anyone help?
    Please note when you have new question in different issue, create new thread, I think this is forum rule.

  22. #22

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    12

    Re: Please help with VBA, for Excel 2007: working with objects

    @Incidentals: thank you very much for your help!

    I will post further questions in a different thread.

  23. #23
    PowerPoster
    Join Date
    Dec 2004
    Posts
    19,947

    Re: Please help with VBA, for Excel 2007: working with objects

    I will post further questions in a different thread.
    in that case if this is finished pls mark resolved

    =CELL("address")
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

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

Survey posted by VBForums.