Logo 
Search:

MS Office Forum

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds

Help on VBA macro

  Asked By: June    Date: Nov 27    Category: MS Office    Views: 1114
  

I have a spreadsheet looks like the following but much larger:

Date A B C
1/5/2007 2.1
1/5/2007 2.3 1.2 3.1
1/5/2007 2.2
1/8/2007 1.2
1/8/2007 1.5 1.7
3/1/2007 2.3
3/5/2007 2.6 2.1

The desired output will be :
Date A B C D E
1/5/2007 2.1 2.3 1.2 3.1 2.2
1/8/2007 1.2 1.5 1.7
3/1/2007 2.3
3/5/2007 2.6 2.1

I tried hard but still can figure out a easy, neat, one-step macro to
do this. Any help would be highly appreciated.

Share: 

 

2 Answers Found

 
Answer #1    Answered By: Daimon Jones     Answered On: Nov 27

ok, what you're trying to do is end up with
one row for each date, then the data in adjacent columns.
Are you wanting the data in any order?
OK.. here's what I did:
Assumptions:
Data is in sheet named "Data", date  in column A, data in B-??
The summary will be in sheet named "Summary"
I defined a Dictionary item to store the data.
It saves LOTS of time instead of looping through an array!
I counted the non-blank cells in Column A of the data sheet
and looped through those cells.
I the dictionary item exists, I appended it with a "," as a separator.
Otherwise, I created the dictionary item.
Once stored, I reported the contents of the dictionary, splitting the data using
the "," separator.
if there is a possibility that the data contains a ",", then you should select
another unique delimiter.
let me know if it helps,


Sub test2()
Dim DDict, Stat, Data_Rowcnt, NewDat, datacnt, I, X, DArray, DataArray
Set DDict = CreateObject("Scripting.Dictionary")
Stat = DDict.RemoveAll 'Clear existing data in Dictionary
'--- Count records
--------------------------------------------------------------------------------\
-
Sheets("Data").Select
Data_Rowcnt =
Application.WorksheetFunction.CountA(Sheets("Data").Range("A1:A65500"))
datacnt = 0
Set DataRange = Sheets("Data").Range(Cells(2, 1), Cells(Data_Rowcnt, 1))
For Each Data In DataRange.Columns(1).Cells
If (Data.Row Mod 100 = 0) Then Application.StatusBar = Data.Row & " of "
& Data_Rowcnt
If (Not DDict.exists(Data.Value)) Then
NewDat = Cells(Data.Row, 2)
For I = 3 To 5
If (Cells(Data.Row, I) & "X" <> "X") Then
NewDat = NewDat & "," & Cells(Data.Row, I)
Else
Exit For
End If
Next I
DDict.Add Data.Value, NewDat
Else
For I = 2 To 5
If (Cells(Data.Row, I) & "X" <> "X") Then
DDict.Item(Data.Value) = DDict.Item(Data.Value) & "," &
Cells(Data.Row, I)
Else
Exit For
End If
Next I
End If
Next Data
Sheets("Summary").Select
Range("A2:Z65000").ClearContents
Range("A1") = "Date"
Range("B1") = "Data"
DArray = DDict.keys
For I = 0 To DDict.Count - 1
Cells(I + 2, 1) = DArray(I)
DataArray = Split(DDict.Item(DArray(I)), ",")
For X = 0 To UBound(DataArray)
Cells(I + 2, X + 2) = DataArray(X)
Next X
Next I
Application.StatusBar = False
End Sub

 
Answer #2    Answered By: Aabirah Khan     Answered On: Nov 27

It works perfect! This is exactly what I want.
Thank you

 
Didn't find what you were looking for? Find more on Help on VBA macro Or get search suggestion and latest updates.




Tagged: