Results 1 to 5 of 5

Need help adjusting VB macro for appending data to rows with matching index numbers

Threaded View

  1. #1
    Registered User
    Join Date
    08-16-2012
    Location
    Portland, OR
    MS-Off Ver
    Excel 2007
    Posts
    24

    Need help adjusting VB macro for appending data to rows with matching index numbers

    Hello-

    I have a macro that was written for me by someone awesome on this forum, however, our data has changed slightly and I cannot figure out how to adjust it.

    We use a program that outputs data onto a spreadsheet. The same mouse is in a box for five minutes, but the program creates a separate row for each minute. Instead, the macro was designed to check the mouse ID in column C, and then move all of the following matching entries into the same row, in order.

    The macro is working, but is not capturing all the data it should- there are five missing entries. I've attached the macro and a copy of the data below.

    It would be really nice if someone could explain how this works a bit in case I need to edit things in the future so I won't have to bother anyone.

    Sub FC3()
    
        
     Dim aNum, b
     Dim i As Long, ii As Long
     With ActiveWorkbook.ActiveSheet
        With .Range("a5:m" & Cells(Rows.Count, "c").End(xlUp).Row)
            aNum = .Value
            .Clear
        End With
        With CreateObject("Scripting.Dictionary")
           .CompareMode = 1
           For indx = LBound(aNum) To UBound(aNum)
               If Not .Exists(aNum(indx, 3)) Then
                   ReDim b(1 To UBound(aNum, 2))
                   For ii = LBound(aNum, 2) To UBound(aNum, 2)
                       b(ii) = aNum(indx, ii)
                   Next
                   .Item(aNum(indx, 3)) = Join(b, ",")
               Else
                   ReDim b(1 To 6)
                   For ii = 1 To 6
                       b(ii) = aNum(indx, ii + 7)
                   Next
                   .Item(aNum(indx, 3)) = .Item(aNum(indx, 3)) & "," & Join(b, ",")
               End If
           Next
           aNum = .Items
        End With
        Application.ScreenUpdating = False
        For i = LBound(aNum) To UBound(aNum)
           x = Split(aNum(i), ",")
           For ii = LBound(x) To UBound(x)
               .Cells(i + 5, ii + 1) = x(ii)
           Next
        Next
        '.Columns("N:N").EntireColumn.Insert
        Application.ScreenUpdating = True
     End With
    End Sub
    Attachment 235963

    Your help is greatly appreciated!
    Last edited by Leith Ross; 05-15-2013 at 05:00 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1