none
Help with sorting RRS feed

  • Question

  • Hello experts.

     

    I'm a student learning Excel VBA, and I need some help with a code. The macro should open a file, then count the number of comments in such file, extract the parent value of the cell where each comment is and sort them in ascending order. I’m asked to save those values in an array, and use a sort method (like Quicksort or Mergesort) or even an excel sheet, and then return the values sorted in a Message Box. I've tried using the array, but since I don’t know beforehand the number of comments in the file, I don’t know how to correctly declare it.

     

    So far this is what I have:

    Sub OrdenaComentarios()
    'Macro que extrae comentarios de un libro de trabajo y los ordena
        Dim varInputBox As Variant
        Dim wkb As Workbook
        Dim strMensaje As String
        Dim wkbFuente As Workbook
        Dim wksFuente As Worksheet
        Dim wksDestino As Worksheet
        Dim intCmm As Integer
        
        varInputBox = InputBox("Por favor, ingrese la dirección del archivo ""Distancias.xlsx""" & Chr(10) & _
        "direcciónencomputadora\Distancias.xlsx")
        
        If varInputBox <> "" Then
            Set wkbFuente = Workbooks.Open(varInputBox)
            Set wksFuente = wkbFuente.Worksheets(1)
            Set wksDestino = ThisWorkbook.Worksheets(2)
            strMensaje = "Valores ordenados:"
            wkbFuente.Activate
            wksFuente.Select
                
            If wksFuente.Comments.Count > 0 Then
                For intCmm = 1 To wksFuente.Comments.Count
                    With wksFuente.Comments(intCmm)
                        wksDestino.Range("A" & (intCmm)).Value = .Parent.Value
                    End With
                    strMensaje = strMensaje & Chr(9) & Chr(10) & Chr(9) & wksFuente.Comments(intCmm).Parent.Value & Chr(9)
                Next intCmm
                MsgBox strMensaje
            Else
                MsgBox "no hay comentarios"
            End If
        Else
            MsgBox "No se ha ingresado una dirección", vbExclamation
        End If
    End Sub

    I’m a native Spanish speaker, so I apologize for the Spanish in the code.

    Tuesday, September 20, 2016 4:28 PM

Answers

  • Try it like this:

    Sub OrdenaComentarios()
        'Macro que extrae comentarios de un libro de trabajo y los ordena
        Dim varInputBox As Variant
        Dim wkb As Workbook
        Dim strMensaje As String
        Dim wkbFuente As Workbook
        Dim wksFuente As Worksheet
        Dim wksDestino As Worksheet
        Dim intCmm As Integer
        
        Set wkbFuente = Workbooks.Open(Application.GetOpenFilename("Excel archivos (*.xlsx; *.xlsm), *.xlsx; *.xlsm", Title:="Por favor, ingrese la dirección del archivo ""Distancias.xlsx"""))
        
        Set wksFuente = wkbFuente.Worksheets(1)
        Set wksDestino = ThisWorkbook.Worksheets(2)
        
        strMensaje = "Valores ordenados:"
        If wksFuente.Comments.Count > 0 Then
            wksDestino.Range("A:A").ClearContents
            For intCmm = 1 To wksFuente.Comments.Count
                With wksFuente.Comments(intCmm)
                    wksDestino.Range("A" & (intCmm)).Value = .Parent.Value
                End With
            Next intCmm
            wksDestino.Range("A:A").Sort key1:=wksDestino.Range("A1"), order1:=xlAscending, Header:=xlNo
            For intCmm = 1 To wksFuente.Comments.Count
                strMensaje = strMensaje & Chr(9) & Chr(10) & Chr(9) & wksDestino.Range("A:A").Cells(intCmm) & Chr(9)
            Next intCmm
            MsgBox strMensaje
        Else
            MsgBox "no hay comentarios"
        End If
        wkbFuente.Close False
    End Sub


    Tuesday, September 20, 2016 5:16 PM