Results 1 to 13 of 13
  1. #1
    2 Star Lounger
    Join Date
    Mar 2004
    Posts
    129
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Data Compression (VBA/Excel 97)

    I would like to take some data and compress it into a more usable form. I've included an example that shows what I'm trying to do. Is there a simple VBA routine that will convert the "Old" data and format it to the "New " form? Thanks.

  2. #2
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Data Compression (VBA/Excel 97)

    See if this does what you want:

    <pre>Public Sub Consolidate()
    Dim I As Long
    Dim oRng1 As Range, oRng2 As Range
    Set oRng1 = Worksheets("Sheet1").Range("A1")
    Set oRng2 = Worksheets("Sheet1").Range("B1")
    For I = Worksheets("Sheet1").Range("A65536").End(xlUp).Row - 1 To 1 Step -1
    If oRng1.Offset(I - 1, 0).Value = oRng1.Offset(I, 0).Value Then
    oRng2.Offset(I - 1, 0).Value = oRng2.Offset(I - 1, 0).Value + oRng2.Offset(I, 0).Value
    oRng1.Offset(I, 1).EntireRow.Delete
    End If
    Next I
    Set oRng1 = Nothing
    Set oRng2 = Nothing
    End Sub
    </pre>

    Legare Coleman

  3. #3
    2 Star Lounger
    Join Date
    Mar 2004
    Posts
    129
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Data Compression (VBA/Excel 97)

    Thanks. This seems to only work for the first entry though. In other words, the "a" entry is compressed and summed and the other data points are deleted.

  4. #4
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Data Compression (VBA/Excel 97)

    If I open the workbook you attached to your first post, paste the macro into it, and run it, then This is what I get:
    Legare Coleman

  5. #5
    2 Star Lounger
    Join Date
    Mar 2004
    Posts
    129
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Data Compression (VBA/Excel 97)

    You are right. My mistake. I had a "_" after my "then" and this was causing my problem. Thanks for your help.

  6. #6
    2 Star Lounger
    Join Date
    Mar 2004
    Posts
    129
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Data Compression (VBA/Excel 97)

    If the data points were not listed together, how could the code be change to control for this? For example if we had

    a
    b
    c
    a
    b
    c

    Instead of

    a
    a
    a

  7. #7
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Data Compression (VBA/Excel 97)

    Insert this line at the beginning of Legare's macro:

    Range(Range("A2"), Range("B65536").End(xlUp)).Sort Key1:=Range("A2")

    This sorts the range before applying the rest of the code.

  8. #8
    2 Star Lounger
    Join Date
    Mar 2004
    Posts
    129
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Data Compression (VBA/Excel 97)

    Could you change the code so that the output appears on another sheet and the original data remains unchanged? Thanks.

  9. #9
    Uranium Lounger
    Join Date
    Dec 2000
    Location
    Salt Lake City, Utah, USA
    Posts
    9,508
    Thanks
    0
    Thanked 6 Times in 6 Posts

    Re: Data Compression (VBA/Excel 97)

    Legare doesn't seem to be about, so here's a perverse revision of his code:

    Public Sub Consolidate()
    Dim I As Long, J As Long
    Dim wksTarget As Worksheet

    J = 1
    With ActiveWorkbook
    Set wksTarget = .Worksheets.Add ' create new sheet for data
    With Worksheets("Sheet1")
    .Range(.[A2], .[B65536].End(xlUp)).Sort Key1:=.[A2]
    For I = 1 To .Range("A65536").End(xlUp).Row - 1
    wksTarget.Cells(J, 1).Value = .<!t>[A1]<!/t>.Offset(I, 0).Value
    wksTarget.Cells(J, 2).Value = wksTarget.Cells(J, 2).Value + .<!t>[B1]<!/t>.Offset(I, 0).Value
    If .<!t>[A1]<!/t>.Offset(I, 0).Value <> .<!t>[A1]<!/t>.Offset(I + 1, 0).Value Then J = J + 1
    Next I
    End With
    End With

    Set wksTarget = Nothing
    End Sub
    -John ... I float in liquid gardens
    UTC -7ąDS

  10. #10
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Data Compression (VBA/Excel 97)

    I would do it like this:

    <pre>Option Explicit

    Public Sub Consolidate()
    Dim I As Long
    Dim oNewSheet As Worksheet
    Dim oRng1 As Range, oRng2 As Range
    Worksheets("Sheet1").Copy After:=Sheets(Sheets.Count)
    Set oNewSheet = ActiveSheet
    oNewSheet.Name = "Consolidated"
    Set oRng1 = oNewSheet.Range("A1")
    Set oRng2 = oNewSheet.Range("B1")
    For I = oNewSheet.Range("A65536").End(xlUp).Row - 1 To 1 Step -1
    If oRng1.Offset(I - 1, 0).Value = oRng1.Offset(I, 0).Value Then
    oRng2.Offset(I - 1, 0).Value = oRng2.Offset(I - 1, 0).Value + oRng2.Offset(I, 0).Value
    oRng1.Offset(I, 1).EntireRow.Delete
    End If
    Next I
    Set oRng1 = Nothing
    Set oRng2 = Nothing
    End Sub
    </pre>

    Legare Coleman

  11. #11
    2 Star Lounger
    Join Date
    Mar 2004
    Posts
    129
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Data Compression (VBA/Excel 97)

    Okay, I've tried to work this out so that I wouldn't have to ask again, but here goes. I have an n x k matrix of data, some columns are text and some numeric. What I want is to take the data in column a (e.g., the "a"s and "b"s from the original example) that are similar and sum the corresponding info (numeric) from a different column, and say this data is in column c. Next, I would like for only the information in those two columns transferred to the new work sheet. I know that this is not what I asked for originally, but I thought that I could figure it out if I had a basic plan to start with. I guess I'm just not destined to be a programmer.

  12. #12
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Data Compression (VBA/Excel 97)

    I'm not sure I completely understand what you are asking. See if this does what you want:

    <pre>Option Explicit

    Public Sub Consolidate()
    Dim I As Long, J As Long, lJMax As Long
    Dim oConSheet As Worksheet, oDetSheet As Worksheet
    Application.ScreenUpdating = False
    Set oDetSheet = ActiveSheet
    On Error Resume Next
    Set oConSheet = Worksheets("Consolidated")
    On Error GoTo 0
    If oConSheet Is Nothing Then
    Set oConSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
    oConSheet.Name = "Consolidated"
    End If
    oConSheet.Range("A2", "IV65536").ClearContents
    For I = 1 To oDetSheet.Range("A65536").End(xlUp).Row - 1
    lJMax = oConSheet.Range("A65536").End(xlUp).Row - 1
    If lJMax = 0 Then
    oConSheet.Range("A1").Offset(1, 0).Value = oDetSheet.Range("A1").Offset(I, 0).Value
    oConSheet.Range("A1").Offset(1, 1).Value = oDetSheet.Range("A1").Offset(I, 2).Value
    Else
    For J = 1 To lJMax
    If oDetSheet.Range("A1").Offset(I, 0).Value = oConSheet.Range("A1").Offset(J, 0).Value Then
    oConSheet.Range("A1").Offset(J, 1).Value = oConSheet.Range("A1").Offset(J, 1).Value _
    + oDetSheet.Range("A1").Offset(I, 2).Value
    Exit For
    End If
    Next J
    If J > lJMax Then
    oConSheet.Range("A1").Offset(J, 0).Value = oDetSheet.Range("A1").Offset(I, 0).Value
    oConSheet.Range("A1").Offset(J, 1).Value = oDetSheet.Range("A1").Offset(I, 2).Value
    End If
    End If
    Next I
    oDetSheet.Activate
    Application.ScreenUpdating = True
    End Sub
    </pre>

    Legare Coleman

  13. #13
    2 Star Lounger
    Join Date
    Mar 2004
    Posts
    129
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Data Compression (VBA/Excel 97)

    That seems to work. Thanks.

Posting Permissions

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