transpose horizantal basing on cellvalue

B

balu

im accessing excel through access by creating excelobject and copyd some
querys to its three columns it is like this
columnA -_________ columnC
month/date_______ values ( say item names)
i want an code to use from access which can TRANSPOSE the cell values of
columnC on to columD horizantally basing on columnA month/date values
i mean values of columnB rows aginest columnA month/date vise to be
transposed month vise it looks like this
10/08 _________ pizza
10/08 _________ pepsi
10/08__________ lava
11/08 _________ beef
11/08 _________ chac
12/08 _________ bread
it should transpose to
Month __ 1 2 3 4 5
10/08 ___ pizza ,pepsi,lava
11/08 ___ beef,chac
12/08 ___ bread
Can any one please helpme
 
J

JLatham

The code below was written in Excel, but should be easily modified for use in
your Access application. Hopefully I've commented it well enough to allow
you to merge it into your Access application:

Sub TransposeData()
Dim myWorkbook As Excel.Workbook
Dim myWS As Excel.Worksheet
Dim datesListRange As Range
Dim anyDateEntry As Range
Dim testDate As Date
Dim baseCell As Range ' where we find new dates
Dim colOffset As Long 'point to where to put item entry
Dim currentRow As Long ' loop control
Dim lastRow As Long

'somewhere you'll have an object that is the Excel Application
' use that object instead of Application. below
'You MAY already have one that represents the workbook, if so
' you can use it instead of myWorkbook in the following
'
'this type of operation has most likely already been done
' you need to put the real name of the workbook in where
' ActiveWorkbook.Name in the next line of code
Set myWorkbook = _
Application.Workbooks(ActiveWorkbook.Name)
'here we set myWS to point at the correct worksheet
' again you may already have set up another object variable
' to represent the workbook itself
' change the name of the sheet as required
Set myWS = myWorkbook.Worksheets("Sheet2")
'determine where dates exist
' this assumes that first data entry is in row 2
lastRow = myWS.Range("A" & Rows.Count).End(xlUp).Row
Set datesListRange = myWS.Range("A2:A" & lastRow)
For Each anyDateEntry In datesListRange
If anyDateEntry <> testDate Then
'get new date to test against
testDate = anyDateEntry
'use as new location to transpose to
Set baseCell = anyDateEntry
colOffset = 3 ' point to column D
Else
baseCell.Offset(0, colOffset) = _
anyDateEntry.Offset(0, 2) ' get from column C
colOffset = colOffset + 1
'erase the data in preparation to delete
'unused rows later
anyDateEntry.Offset(0, 2).ClearContents
End If
Next
'this section deletes rows with empty cell
'in column C
For currentRow = lastRow To 2 Step -1
If IsEmpty(myWS.Range("C" & currentRow)) Then
myWS.Range("C" & currentRow).EntireRow.Delete
End If
Next
'use this code to clean up after all is done
'releases objects back to the system
Set datesListRange = Nothing
Set myWS = Nothing
'may not want to release this just yet, but
Set myWorkbook = Nothing
End Sub
 
Top