Posts by Red Smurf

Re: Worksheet Change not doing anything

Hi,
I've just been doing something else on the file on a different, unrelated sheet and I've noticed that the Worksheet_Change on that sheet isn't working either - this would suggest to me that the problem is something to do with the events not being enabled- even though I've said specifically that they should be. Does that help at all?

I've just put a few checks in place to write "check" in specific cells at various points of the code - hoping to isolate where the problem is in the code. What I've found is the Worksheet_Change code is not running at all. Is this to do with the EnableEvents?

Many thanks
Red Smurf

Re: Worksheet Change not doing anything

Quote from KjBox;720198

Try running the code with the "Email Check" sheet visible, If that works then you are going to have to include code to unhide the sheet, then make it Very Hidden again after it has been updated.

Another possible cause could be the sheet name. Make sure there is not a leading or trailing space in the sheet name. If there is then Sheets("Email Check") would not find the sheet. This is a good reason for using Sheet CodeName in code rather than Sheet name or sheet index.

Many thanks - just double checked, and copy pasted the sheet names from the sheet tabs to the code - unfortunately no success

Re: Worksheet Change not doing anything

Hi,
Just tried - it's doesn't make any difference at all.
Thanks for the thought though
Red Smurf

Re: Worksheet Change not doing anything

Hi,

No luck with either unfortunately.

In my file the sheet that's feeding my problem sheet is veryhidden - would that make a difference?

Many thanks,

Re: Worksheet Change not doing anything

Many thanks Holger, but neither method has worked. I used the intersect as follows:

Private Sub Worksheet_Change(ByVal Target As Range)




Dim i As Integer




For i = 15 To 39
    If Sheets("Email Check").Range("C12").Value = "" Then
    
    ElseIf Not Intersect(Target, Range("D15:D39")) Is Nothing Then
        Application .EnableEvents = False
        Sheets("Email Check").Range("F" & i).Value = Sheets("Email Check Workings").Range("F" & i).Value
        With Sheets("Email Check").Range("C" & i)
            .Value = Sheets("Email Check Workings").Range("C" & i).Value
            .HorizontalAlignment = xlRight
        End With
        Sheets("Email Check").Range("H9").Value = i
        Application .EnableEvents = True
    End If
Next i




End Sub

I've tried taking out the reference to cell C12 as well and that doesn't work either - my check line re putting the value of i in H9 is not being actioned either which makes me suspect that the whole procedure isn't starting at all. Do you have any other ideas?

Many thanks,

Red Smurf

Re: Worksheet Change not doing anything

It's a little tricky because it's part of a much larger project with hundreds of client details (about 3.5MB). I've tried to cut the bit out with the problem together with the other sheets which affect the results and I can't get the size down below the 205KB max and include all the sheets, so I've attached only the problem page and the page it feeds from directly There's a few sheets which work in conjunction with the one I'm having the problem with. A Menu sheet, Email Check sheet (this is the problem one), Email Check Workings - no macros here just excel formulas which are working perfectly, Classic Members which is just data, and City members which is just dataThere is a button on the Menu sheet to take you to the Email Check sheet. Here's the code for the button:

Sub Email_Check_Page()Application.ScreenUpdating = FalseSheets("Email Check").Visible = xlSheetVisibleFor Each ws In ActiveWorkbook.Worksheets     ''''''''''to hide everything except the sheet I want to go to    If ws.Name = "Email Check" Then    Else    ws.Visible = xlSheetVeryHidden    End IfNext wsSheets("Email Check").Range("D15:D39").Value = ""    '''''''''to clear the cells on the newly opened sheet Sheets("Email Check").Range("C12").Value = ""          '''''''''every time the sheet is openedSheets("Email Check").Range("F15:F39").Value = ""Call EnableEvents                                                  ''''''''''''small macro to ensure events are enabled  Application.ScreenUpdating = TrueEnd Sub

Then the problem page opens and you use a dropdown menu to select with City or Classic in cell C12 enter numbers in the cells in column D. If there's a number in column D then cells F on the same line should fill automatically - but this doesn't work Any help would be great - many thanks,

Hi,

I'm sorry in advance because other people have asked similar questions and I've been through them and tried to apply the help given to my situation without success.

I am putting together a mini-database of information and I have a sheet that I want to update automatically every time a change is made, therefore I've set up a few lines telling the sheet what I want it to do as a Worksheet_Change sub (you'll see below):

Private Sub Worksheet_Change(ByVal Target As Range)
Call EnableEvents




Dim i As Integer




For i = 15 To 39
    If Sheets("Email Check").Range("C12").Value = "" Then
    
    ElseIf Sheets("Email Check").Range("D" & i).Value = "" Then
    Else
        Sheets("Email Check").Range("F" & i).Value = Sheets("Email Check Workings").Range("F" & i).Value
        With Sheets("Email Check").Range("C" & i)
            .Value = Sheets("Email Check Workings").Range("C" & i).Value
            .HorizontalAlignment = xlRight
        End With
        Sheets("Email Check").Range("H9").Value = i
    End If
Next i




End Sub

I don't think I've disabled the events, but as you can see the first thing I'm doing is enabling the events - just as a precaution.
There is data in cell C12 and D15 so the Else part of the if procedure should run. The Email Check Workings sheet is "veryhidden" but the cell F15 on that sheet fills automatically dependent on what is cells C12 and D15 of the Email Check sheet.

I've even put a check in there telling it to put the value of i into cell H9 - just to see if the whole procedure is running - and that is not happenning.

I've been through step by step several times and I just can't see it.

If anyone can help I would be most grateful.

Many thanks,

Red Smurf

Hi,

I have been asked to put together a basic email to thousands of email addresses based on a specific template in excel. I've done this before but never needed to include font formatting or pictures within the body of the text, so as a result I'm using html for the first time.

I've included a snippet from my code below which is looking at the part of the code causing me problems:

Set App = CreateObject("Outlook.Application")    Set Itm = App.CreateItem(0)
    With Itm
    .Subject = Sheets("Sheet1").Range("B3").Value
    .SentOnBehalfOfname = Sheets("Sheet1").Range("B2").Value
    .To = Sheets("Sheet1").Range("B1").Value
    .cc = ""




    .htmlbody = "Dear " & Sheets(Sheet1).Range("B4").Value & "< br <> br >" & _''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     "<b>" & Sheets(Sheet1).Range("B5").Value & "</b>< br <> br >" & _''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     Sheets(Sheet1).Range("B6").Value & "< br <> br >" & _ ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''  here's my problem area
     Sheets(Sheet1).Range("B7").Value & "< br <> br >" & _ ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     Sheets(Sheet1).Range("B8").Value & "< br <> br >" & _ ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     "Kind regards,<br<>br>" & _''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     "Andy Skillicorn" & _''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
     "<img src =file://C:/Users/dimitri.adam/Pictures/New Key Dec2013 v2.png width=413 height=294>"   '''''''''''''''''''''''''''''''''''''''''''''
    
 
    .Display
    End With

Can anyone help me out? What am I doing wrong?

Many thanks in advance

Re: Macro To Move Messages To Multiple Folders

Many thanks for your help on this - it works perfectly, even better that I had hoped I will never again have an inbox of 28000 items

Evil Red Smurf

Re: Macro To Move Messages To Multiple Folders

Hi Cytop,

Many thanks for your code. I'm struggling understanding what it's doing though.

1. cMails is setup as a collection of the email IDs - no problem
2. emails satisfying the terms are copied and the copy moved to the respective folder - no problem
3. the EntryID is added to the cMAILS collection - ok

but I don't understand what the final section is doing (from Do while cMails.count >0). Are we recreating the email from the ID and then looping back to the beginning and going through the list again? If so what's stopping the emails being copied to the same folder again and again?

Many thanks

Re: Macro To Move Messages To Multiple Folders

I'll have a closer look at this over the weekend and let you know.

Have a great weekend, and thanks again

Re: Macro To Move Messages To Multiple Folders

Many thanks for your reply.

Each message may be linked to more than one category, hence I've instructed the copy to be moved - ie I want the same message to be included in 2, 3, or even 4 different folders. I thought that by moving the copies and then deleting the originals I would be able to do this relatively easily, however the copies are not getting to the folders AND the originals are deleted. You mentioned about whether the destination folder is correct, all of the destination folders are sub-folders of the inbox - is my code correctly describing this?

Any many thanks for your help.

Hi,

I've prepared a macro to look at my inbox and automatically file messages to certain folders based on the age, category, and status of each message. Basically whether the message is filed or not depends on 2 things - is it marked as complete and was it received more than 5 days ago. If these conditions are met then the folder(s) that the messages are copied to depend on the categories assigned to the message. However it doesn't seem to be working properly and I'm struggling to see why. The problem that it's having is that it's not moving the copied messages to the folders and instead just deleting the messages:

Dim ns As Outlook.NameSpace
Dim objItem As Object
Dim FolderInbox As Folder
Dim MyItem As Outlook.MailItem


Set ns = Application.GetNamespace("MAPI")
Set FolderInbox = ns.GetDefaultFolder(olFolderInbox)


For Each objItem In FolderInbox.Items   
     If objItem.ReceivedTime < Now - 5 And objItem.FlagStatus = 1 Then        


          If objItem.Categories = "B&C Limited" Then            
               Set MyItem = objItem.Copy            
               MyItem.Move FolderInbox.Folders("B&C")        
          Else        
          End If                


If objItem.Categories = "IT" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("IT")        
Else        
End If                
If objItem.Categories = "Funnies" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("Personal")        
Else        
End If                
If objItem.Categories = "Hideaways Amsterdam" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("THC Amsterdam")        
Else        
End If                
If objItem.Categories = "Hideaways Gib" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("THC Gib")        
Else        
End If                
If objItem.Categories = "Hideaways London" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("THC London")        
Else        
End If                
If objItem.Categories = "Personal" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("Personal")        
Else        
End If                
If objItem.Categories = "Propco 1" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("Propco1")        
Else        
End If                
If objItem.Categories = "Propco 2" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("Propco2")        
Else        
End If            
If objItem.Categories = "Leases" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("B&C")        
Else        
End If                
If objItem.Categories = "Fund Provision Fee" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("Payments")        
Else        
End If                
If objItem.Categories = "Payments" Then            
Set MyItem = objItem.Copy            
MyItem.Move FolderInbox.Folders("Payments")        
Else        
End If                


objItem.Delete
    
Else    
End If
NextEnd Sub

If anyone can suggest where my macro is going wrong I would be very grateful for any and all help.

Many thanks in advance

Re: VBA macro To Move Shape Around Spreadsheet

Thanks Ger and Dave,

I'm going to have a good look at those links and try to rearrange my code accordingly.

I don't understand all the code being used in the links, but I'll change the numbers around and try to work it out - it's the best way to learn!

I'll have a play with the i as suggested as well.

Many thanks

Red Smurf

Re: Moving Shapes

Thanks for the instruction Ger, however I'm still stuck.
The aim of the code is to move the shape around the square path so that it visibly moves and doesn't just jump between various positions with no visible movement inbetween, and I managed that using the code we're talking about. The problem is with the downward motion. There is sufficient space for the shape to move without going to D0 as in your example, or even trying to go pre-column A - in fact the cell reference that the shape is supposed to c direction is K13.
Any further ideas would be fantastic.
Many thanks,

Re: Moving Shapes

Hi,
sor - and no, changing d and i to long doesn't make a difference
Thanks,

Re: Moving Shapes

Hi,

"checkposred" is a seperate set of code that looks at the position of the shape's top-left corner and if it reaches a pre-set column then it is this set of code that changes the value of cell A1 between up/down/left/right. The thing that get me is that the shape starts half-way down the spreadsheet, goes to the right, then changes direction to go up, then changes direction to go left, and it is only at that topleft corner of the square path that the code fails. The shape moves to the left approaching the problem corner with the topleft corner of the shape following row 13. It is then supposed to change direction when it reaches column K it is supposed to change direction and go down. "checkposred" changes the text in cell A1 to down, but the error pops up and DEBUG highlights .Top = .Top + etc.... . Sorry if this doesn't help, but any other ideas?
Thanks,

Hi,

I am trying to write a set of code, part of which involves moving a shape around an excel spreadsheet in a square shape within a certain range. It is based on a random number generator. The shape moves a number of cells to the left/right/up/down depending on the random number (d) multiplied by 16. If the shape reaches a row or column border point, it will change direction but continue moving in the new direction until it has gone as far as was determined by the random number (*16). I have some code which works fine... to a point! The shape starts out, reaches a right hand border, changes direction to go up, reaches another border, changes again and goes left, but then when it comes to change dorection the 3rd time and go down, it fails. The direction of the shape is determined by a word in cell A1 - left/right/up/down:

Sub MoveRed()
    Application.ScreenUpdating = True
Dim d As Integer
Dim i As Integer


d = Range("AZ1").Value


With ActiveSheet.Shapes("RedDot")
For i = 1 To 16 * d                 


Select Case Range("A1").Value
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''This section is where the problem is''''''''''''''''''''''''''''''''
    Case "down"                    
        .Top = .Top + .TopLeftCell.Offset(-i).Height    
        DoEvents                                        
        WAIT                                            
        checkposred                                     
'''''''''''''''''''''This section is where the problem is'''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Case "right"                                                
        .Left = .Left + .TopLeftCell.Offset(-i).Height          
        DoEvents                                                
        WAIT                                                    
        checkposred                                             
    Case "up"                                                   
        .Top = .Top - .TopLeftCell.Offset(i).Height           
        DoEvents                                                
        WAIT                                                    
        checkposred                                             
    Case "left"                                                 
        .Left = .Left - .TopLeftCell.Offset(i).Height           
        DoEvents                                               
        WAIT                                                    
        checkposred                                            
End Select                                                      


Next
End With


End Sub

As highlighted, I'm told that there's an error in the "down" section in particular with .Top = .Top + .TopLeftCell.Offset(-i).Height, the problem is I can't see where the error is! I apologise in advance for wasting your time if this is a simple, stupid mistake, but I've been over it so many times now I wouldn't see it if it hit me with a big wet fish!
Many thanks in advance for your help