• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Can Excel Do this?

Mglines

New Member
Ok I was able to figure out how to format data into a sheet now I was wondering how I can get the data into this type of format. When someone pasts into my sheet a consitantly formated data set. I have a sheet that will format the data into the Columns

DTSTART DTEND DESCRIPTION LOCATION


I will than want to have the excel file format it in the below way. I am trying to do this in excel instead of doing it in access.(which I am no better at using) I then will be able to save the page as an ICS to allow them to import it into Google, Ical, Outlook etc.


BEGIN:VCALENDAR

BEGIN:VEVENT

DTSTART:20101120T020000Z

DTEND:20101120T030000Z

UID:

DESCRIPTION:CSV Test

LOCATION:Building A room 222

SEQUENCE:0

STATUS:CONFIRMED

SUMMARY:Edit Test

TRANSP:OPAQUE

END:VEVENT


BEGIN:VEVENT

DTSTART:20101120T020000

DTEND:20101120T030000

UID:

DESCRIPTION:CSV Test

LOCATION: Building B Room 111

SEQUENCE:0

STATUS:CONFIRMED

SUMMARY: Budget Meeting

TRANSP:OPAQUE

END:VEVENT

END:VCALENDAR
 
Mglines

Try the following VBA Code

Copy and paste it into a code module in VBA

[pre]
Code:
Sub MakeVCF()

ReDim cal(4, 1) As Variant
Dim i As Integer, j As Integer
Dim mystring As String
Dim Dstsht As String, Srcsht As String

i = 1 'Row No
j = 0 'Record No
Srcsht = "Sheet4" 'Source sheet change to suit
Dstsht = "Sheet3" 'Destination sheet change to suit

Do
mystring = Worksheets(Srcsht).Cells(i, 1).Value 'change sheet name to suit

If mystring = "END:VCALENDAR" Then Exit Do
If Left(mystring, 5) = "DTSTA" Then
j = j + 1
ReDim Preserve cal(4, j)
cal(1, j) = Right(mystring, Len(mystring) - InStr(1, mystring, ":"))
End If

If Left(mystring, 5) = "DTEND" Then cal(2, j) = Right(mystring, Len(mystring) - InStr(1, mystring, ":"))
If Left(mystring, 5) = "DESCR" Then cal(3, j) = Right(mystring, Len(mystring) - InStr(1, mystring, ":"))
If Left(mystring, 5) = "LOCAT" Then cal(4, j) = Right(mystring, Len(mystring) - InStr(1, mystring, ":"))

i = i + 1 'move to next row

Loop Until mystring = "END:VCALENDAR"

'Now write data to a new sheet
For i = 1 To UBound(cal(), 2)
For j = 1 To 4
Worksheets(Dstsht).Cells(i, j) = cal(j, i)
Next
Next

End Sub
[/pre]
 
After struggling with this some I cant quite get the VBA macro to work. I was able to format the data like I wanted with vlookup and alot of If statements.


I loaded the document here:

https://docs.google.com/leaf?id=0BytPv8j-NhOzMzU3N2M5ODItZjY0Yi00ODY4LWFhMWUtNmViNjRjNWVjM2Yw&sort=name&layout=list&num=50


I need the data in FormattedData tab to be transposed to Tab 1 (FinalICSFile)

So it neds to go from

BEGIN DTSTART DTEND Location DESCRIPTION Summary END

VEVENT 2010 20101117 Golf Tournament Bentwinds VEVENT


look like this


BEGIN:VCALENDAR

BEGIN:VEVENT

DTSTART:2010

DTEND:2010

DESCRIPTION:Tournament

LOCATION:Without Z

SUMMARY: Golf

END:VEVENT

END:VCALENDAR


For size purposes I will probably limit the creation to 200 Rows of data to be pasted in the Paste Data Here tab.


I kept getting data errors on the above pasted code and made some changes but figured it would be easier to just post my spread sheet.


Thank you for the help.

Anyway this could be done without VBA?
 
[pre]
Public Function MakeVCF()
Dim mtxCal As Variant
Dim Source As Worksheet
Dim Target As Worksheet
Dim Lastrow As Long
Dim i As Long

i = 2 'Row No
j = 0 'Record No
Set Source = Worksheets("Data") 'Source sheet change to suit
Set Target = Worksheets("Cal") 'Destination sheet change to suit

With Source

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
ReDim mtxCal(1 To 10, 1 To Lastrow - 1) As Variant

For i = 2 To Lastrow

mtxCal(1, i - 1) = "BEGIN:VCALENDAR"
mtxCal(2, i - 1) = "BEGIN: " & .Cells(i, "A").Value
mtxCal(3, i - 1) = "DTSTART:" & .Cells(i, "B").Value
mtxCal(4, i - 1) = "DTEND:" & .Cells(i, "C").Value
mtxCal(5, i - 1) = "DESCRIPTION: " & .Cells(i, "E").Value
mtxCal(6, i - 1) = "LOCATION: " & .Cells(i, "D").Value
mtxCal(7, i - 1) = "SUMMARY: " & .Cells(i, "F").Value
mtxCal(8, i - 1) = "End: " & .Cells(i, "G").Value
mtxCal(9, i - 1) = "End: VCALENDAR"
mtxCal(10, i - 1) = ""
Next i

End With

Target.Range("A1").Resize((Lastrow - 1) * 9) = mtxCal

End Function
[/pre]
 
reposted the file here

http://www.mediafire.com/?bxjdyuqf49f58tm


Thank you xld this really gives me a place to work from.

the code you posted did one row of data fine but did not do the next 10 rows.. this was my output with about 1k rows of #N/A's. I will see if I can figure out what is going on with it.


BEGIN:VCALENDAR

BEGIN: VEVENT

DTSTART:20101130T160000

DTEND:20101130T190000

DESCRIPTION: Dean Smith Center: Technology Lab 50

LOCATION: SchoolDude.com

SUMMARY: FMC Event

End: VEVENT

End: VCALENDAR


#N/A

#N/A

#N/A
 
Oops, my bad. Try this

[pre]
Public Function MakeVCF()
Dim vecCal As Variant
Dim Source As Worksheet
Dim Target As Worksheet
Dim Lastrow As Long
Dim i As Long

i = 2 'Row No
j = 0 'Record No
Set Source = Worksheets("Data") 'Source sheet change to suit
Set Target = Worksheets("Cal") 'Destination sheet change to suit

With Source

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
ReDim mtxCal(1 To (Lastrow - 1) * 10) As Variant

For i = 2 To Lastrow

mtxCal((i - 2) * 10 + 1) = "BEGIN:VCALENDAR"
mtxCal((i - 2) * 10 + 2) = "BEGIN: " & .Cells(i, "A").Value
mtxCal((i - 2) * 10 + 3) = "DTSTART:" & .Cells(i, "B").Value
mtxCal((i - 2) * 10 + 4) = "DTEND:" & .Cells(i, "C").Value
mtxCal((i - 2) * 10 + 5) = "DESCRIPTION: " & .Cells(i, "E").Value
mtxCal((i - 2) * 10 + 6) = "LOCATION: " & .Cells(i, "D").Value
mtxCal((i - 2) * 10 + 7) = "SUMMARY: " & .Cells(i, "F").Value
mtxCal((i - 2) * 10 + 8) = "End: " & .Cells(i, "G").Value
mtxCal((i - 2) * 10 + 9) = "End: VCALENDAR"
mtxCal((i - 2) * 10 + 10) = ""
Next i

End With

Target.Range("A1").Resize((Lastrow - 2) * 9) = Application.Transpose(mtxCal)

End Function
[/pre]
 
xld sooooo close, I really appreciate your help with this.


Format should be


Start with

BEGIN:VCALENDAR


Then Run

mtxCal((i - 2) * 10 + 2) = "BEGIN: " & .Cells(i, "A").Value

mtxCal((i - 2) * 10 + 3) = "DTSTART:" & .Cells(i, "B").Value

mtxCal((i - 2) * 10 + 4) = "DTEND:" & .Cells(i, "C").Value

mtxCal((i - 2) * 10 + 5) = "DESCRIPTION: " & .Cells(i, "E").Value

mtxCal((i - 2) * 10 + 6) = "LOCATION: " & .Cells(i, "D").Value

mtxCal((i - 2) * 10 + 7) = "SUMMARY: " & .Cells(i, "F").Value

mtxCal((i - 2) * 10 + 8) = "End: " & .Cells(i, "G").Value

mtxCal((i - 2) * 10 + 10) = ""


Loop until the Value of Cell (i, "A") is blank

Then write statement "End: VCALENDAR"


Then

End With


Target.Range("A1").Resize((Lastrow - 2) * 9) = Application.Transpose(mtxCal)
 
Another shot

[pre]
Public Function MakeVCF()
Dim vecCal As Variant
Dim Keysh As Worksheet
Dim Source As Worksheet
Dim Target As Worksheet
Dim Lastrow As Long
Dim i As Long

i = 2 'Row No
Set Keysh = Worksheets("Paste Data Here") 'Real data sheet change to suit
Set Source = Worksheets("FormattedData") 'Source sheet change to suit
Set Target = Worksheets("Cal") 'Destination sheet change to suit

With Source

Lastrow = Keysh.Cells(Keysh.Rows.Count, "A").End(xlUp).Row
ReDim mtxCal(1 To (Lastrow - 1) * 8 + 2) As Variant
mtxCal(1) = "BEGIN:VCALENDAR"

For i = 2 To Lastrow

mtxCal((i - 2) * 8 + 2) = "BEGIN: " & .Cells(i, "A").Value
mtxCal((i - 2) * 8 + 3) = "DTSTART:" & .Cells(i, "B").Value
mtxCal((i - 2) * 8 + 4) = "DTEND:" & .Cells(i, "C").Value
mtxCal((i - 2) * 8 + 5) = "DESCRIPTION: " & .Cells(i, "E").Value
mtxCal((i - 2) * 8 + 6) = "LOCATION: " & .Cells(i, "D").Value
mtxCal((i - 2) * 8 + 7) = "SUMMARY: " & .Cells(i, "F").Value
mtxCal((i - 2) * 8 + 8) = "End: " & .Cells(i, "G").Value
mtxCal((i - 2) * 8 + 9) = ""
Next i

mtxCal((Lastrow - 1) * 8 + 2) = "End: VCALENDAR"
End With

Target.Range("A1").Resize((Lastrow - 1) * 8 + 2) = Application.Transpose(mtxCal)

End Function
[/pre]
 
This worked great.. I had to fix a few things with my vlookup and some formatting but in the end it works!


they run the script and save it as a txt file and can load the file into google, outlook or ical!


Thank you!
 
Back
Top