Solved: Combining two bits of vba

[georgedaws]

Hello,

I found this site and I have found all the example files really helpful. I never knew there was so much that could be done with excel.

I am a complete beginner, so please bear with what might be such an easy solution.

I have found this excellent pop up calendar (attached). I would like to use it with my existing spreadsheet which is not a problem.

The trouble is I have this code to protect the cells once data is entered


[VBA]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ans As Variant
If Application.Intersect(Target, Range("B1:B5")) Is Nothing Then Exit Sub
If Target.Locked = True Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "Changes are not allowed in this cell"
Exit Sub
End If
Ans = MsgBox("Are you sure you want to enter " & Target.Value, vbQuestion + vbYesNo, "Confirm Entry")
If Ans = vbYes Then
ActiveSheet.Unprotect
Target.Locked = True
ActiveSheet.Protect contents:=True
End If
End Sub[/VBA]


I have tried to combine these so that simply put I can click on the cell, the calendar pops up, I choose the date, then I get the "are you sure ?" message, click yes or no. If I click yes cell locks, or no and I can re-enter.


Sorry if I have rambled on. What I did was to paste one code beneath the other but I was getting errors.

Any help would be appreciated. (and any pointer of how "generally" two different commands would normally go together.


Thanks for looking.

georgedaws

[Ken Puls]

Just as an alternate approach here...

If you put the following in the ThisWorkbook module, it will protect the sheet, but allow your code to still run without having to toggle the protection:

[vba]Private Sub Workbook_Open()
Worksheets("Sheet1").Protect Password:="MyPassword", userinterfaceonly:=True
End Sub[/vba]

If that isn't sufficient though, we can always look at the way you suggested orginally...

[georgedaws]

Hi Ken,

Thanks for your reply,

I am going to give it a go and see what happens.

Sorry for the post title, I am so new at all of this, I couldn't even think of how I should have put it.

I will let you know,

Thanks again,

Stewart

[georgedaws]

Hi Ken,

I have tried the code but unfortunately I still need to have the message box pop up after I put the calendar in.

Trouble I am having at the moment is that on my main spreadsheet I have titles that I want kept locked-which is fine- on its own.

The range of cells that I choose to have a calendar pop up need to be locked once the "are you sure?" choice is given.

At the moment all I have is the posted code which is fine but all i have to do to unlock the date cell is format cells-protection and untick "locked"

I need others to be prevented from doing this as we have some right "pranksters" at work.

Thanks in advance for your help.

Stewart

[koala]

Stewart,

I am fairly new to VBA and use this site to learn a lot.

I know this doesnt solve your issue, (and my knowledge isnt good enough to give you any pointers) however I was looking at your pop up calendar, and cant seem to understand the code so was hoping you could tell me why only January is shown for the month.

cheers
Koala

[Ken Puls]

Sorry Stewart, I didn't read that thoroughly enough the first time.

Okay, so here's what I would do. I'd still put the code I gave you about in the ThisWorkbook module, just to make sure the sheet is protected. I'd then modify your code above to:

[vba]Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ans As Variant

If Application.Intersect(Target, Range("B1:B5")) Is Nothing Then Exit Sub
Ans = MsgBox("Are you sure you want to enter " & Target.Value, vbQuestion + vbYesNo, "Confirm Entry")
If Ans = vbYes Then Target.Locked = True
End Sub[/vba]

Finally, I'd modify the routine that kicks off the calendar to test if the cell is locked first. If it is, don't fire the calendar at all. (And tell the user)

[vba]Private Sub Worksheet_selectionChange(ByVal Target As Range)
Select Case Target.Column
Case 2, 3
Select Case Target.Row
Case 1 To 5
If Target.Locked Then
MsgBox "MC Hammer says... you can't touch this!"
Else
Call Pop_Cal
End If
End Select
End Select
End Sub[/vba]

Hope it helps,

[Bob Phillips]

I know this doesnt solve your issue, (and my knowledge isnt good enough to give you any pointers) however I was looking at your pop up calendar, and cant seem to understand the code so was hoping you could tell me why only January is shown for the month.

I also get this problem, and I think it is because the code is US-centric, and is not taking account of international date issues (we have dates in dd/mm format, the US has mm/dd format).

In the routine CF_Int, there is this line of code

[vba]

LB_Mth.AddItem Format((I) & "/1/" & (ThisYear), "mmmm")
[/vba]

Change it to

[vba]

LB_Mth.AddItem Format(DateSerial(ThisYear, I, 1), "mmmm")
[/vba]

and it should work for you too.

[koala]

Thanks XLD, you are a legend. It works perfectly.

That was the line of code I was trying to change, but couldnt get it right. (and never would have without your help.)

cheers
Koala

[georgedaws]

Hi Ken and XLD,

Been working nights so I have just had a look at your suggestions.

Ken I love the message box message LOL!

I will have a go now and see if it all works (fingers crossed) and report back.

Thanks again,

Stewart

[georgedaws]

Hi koala,

Sorry I haven't replied, I have been working odd hours but I see it's been answered. I didn't want you to think I was being ignorant.

Regards,

Stewart

[georgedaws]

Hi Ken,

Worked like an absolute charm!

The great thing is now I can work backwards and learn how you did it.

You know what would be good? Being able to have a macro call an mp3 clip playing "you can't touch this" when the message pops up!

Start a "Pimp my spreadsheet" section!

Thanks Ken, much appreciated.

Stewart

[Ken Puls]

See, now, if your'e serious that can be done. Your co-workers would probably want to kill you after about 3 weeks, but it's is certainly a possibility...

[georgedaws]

Ken, I wish you never told me that it could be done. Just to let you know (again) that all the cells lock properly with all the correct messages and calendars.

I know I have digressed with this thread and I am sorry! I am presenting this to a group and I would love to have one for the presentation that played the music. Additionally it would be great to know how it is done to play any sound as opposed to the normal "ding noise"

I appreciate you probably have more important questions to answer, so if you ever get chance to post the code for it, I will pass all credit of the presentation to you!

Thanks again for your help Ken,

Stewart

[Ken Puls]

LOL! Sorry about that.

Do you have a copy of the song, and what format is it in? I can't provide you with that piece, of course.

And realistictly, when when is your presentation? I'm nutty busy, but this could be kind of fun...

[geekgirlau]

I found this method here, but it's restricted to WAV files.

Another solution might be to have a hidden range containing a hyperlink to the sound file. You could then do this:

[vba]
Sub SoundLink()
Dim hyp As Hyperlink

For Each hyp In Range("PlaySound").Hyperlinks
hyp.Follow
Next hyp
End Sub
[/vba]

[georgedaws]

Hi Ken,

I have just clipped "hammertime" for you to play with. That was a job in itself!

Whenever you can do it is fine. I can't wait to hear it kick in though. Ah! The little thing's that make us laugh.....

Thanks again,

Stewart

[georgedaws]

Hi geekgirlau,

Thanks for your reply. It.s not a problem to have .wav files because I can always convert an mp3. I will have a look at that link and post back once I manage to prise my kids off my legs.......

[Bob Phillips]

[vba]


Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" ( _
ByVal lpszSoundName As String, _
ByVal uFlags As Long) As Long

Public Function PlayWavFile(WavFileName As String, Wait As Boolean)
If Dir(WavFileName) = "" Then Exit Function
If Wait Then
sndPlaySound WavFileName, 0
Else
sndPlaySound WavFileName, 1
End If
End Function

Sub TestPlayWavFile()
PlayWavFile "C:\Documents and Settings\Bob\My Documents\mchammer.wav", True
MsgBox "This is visible after the sound is finished playing..."
End Sub
[/vba]

[georgedaws]

Hi xld,

Thanks for the code, I had an error of which I had to put "Ptrsafe" before function and change Public to Private.

Question is; whereabouts do I put the code please? Complete novice here.

Thanks,

Stewart

[georgedaws]

Hi again,

I have pasterd this code into my workbook and I have given it the correct path, but I still get the "ding noise" with my custom pop up message. It is definately a .wav file so I am stumped.

Any ideas please?.....

Thanks,

Stewart