Posts by JimmyB

Yeah it's weird. It works on all of the 43 sheets just fine...just not that one...No real matter though, I went around it by Unprotecting at the start of the sub and protecting at the end. Works fine

Anyway thanks for your help

JimmyB

Stay safe & have a great week

Good Morning...well it's still morning here anyway...LOL

Here's the code I used. The line is imbedded at the end of the 'for' statement .

Heading out for the day. Will check back later.

Thanks JimmyB

It normally works on all of the other 43 sheets

 '''This next block shuts off gridlines & headings on the sheets _
            with the exceptions as listed in the "If" statement
            
        '''This also allows the macros to run on protected sheets

    For Each ws In ThisWorkbook.Worksheets
        If ws.name = "VALUES for MEALS" Or ws.name = "Calories" Or ws.name = "Tot Fat" _
        Or ws.name = "Trans Fat" Or ws.name = "Cholesterol" Or ws.name = "Sodium" _
        Or ws.name = "Carbs" Or ws.name = "Fibre" Or ws.name = "Sugar" _
        Or ws.name = "Protein" Or ws.name = "Meals Data" _
        Or ws.name = "Sheet1" Or ws.name = "Sheet2" Or ws.name = "Sheet3" Or ws.name = "Sheet4" _
        Or ws.name = "Sheet5" Or ws.name = "Sheet6" Then GoTo Jump1
        ws.Activate
        ActiveWindow.DisplayGridlines = False
        ActiveWindow.DisplayHeadings = False
Jump1:
        ws.Protect "Pamela491", UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True
    Next ws

Hi Jolivanes. Thread #3 was confusing & I didn't know exactly how to respond. Thought you were just making a statement of sorts...now (I guess) I get it. When I advised Roy that I sent him my code, I probably should not have worded as such. instead of "I sent it to you", maybe I could have lengthened it to "I placed the code on the thread..."or something to that effect, so as to make it clearer for you. Sa-sorry if this inconvenienced you in any way. will try to be more careful in the future.

Hi Dave thanks for the offer of information. I input the line of code as you recommended and with a bit of tweaking I think that it would have worked...but there was still some issues. Since I also had a recommendation from Roy, I thought I'd give his code a try...no offence please. He has the same idea with the cut and paste on the same line as you suggested, but with a little twist.

Hey Roy, you pulled through for me AGAIN. I uploaded your code and it worked right off the bat. The only thing that I had to do was unprotect my target sheet, for it to paste. (so unprotected at beginning of sub then protecting at the end). That's fine but I wonder why. I have the code in the 'Workbook Open' event, to allow all macros able to perform on protected sheets and it works perfectly everywhere else. Hmmm...don't know, but I'm happy with the help I received from Dave, Logit and Yourself. In the future, per your recommendation, I will be declaring all of my variables and will do so on the subs of this existing program that I've finally completed thanks to the help I've received from people like you guys at Ozgrid.

Thanks again JimmyB

Thanks all. I'll respond and tryout tonight when I am available

Thanks JimmyB

Hi Jolivanes Hi Roy

I have no idea why you sent me either of the notes (Thread #2 & Thread #10) or why Roy answered you saying "He hasn't sent me any code!!!" (Roy, Thread # 4 advised me to be more specific...so in Thread #6 I explained everything regarding my problems and attached the code with Rem statements explaining each line.

Really guys I totally appreciate your help and have no intention of creating excess drama, but I am at a loss for words. You guys have been a lot of help and again...I appreciate it, but don't know what you want from me. I'm trying my best.

Thanks JimmyB

Thanks Roy. If you get a chance can you please look at the code that I sent you?

Will check back in the morning...Thanks again

Hi Roy.. Sorry for the late response. I've been sick for the last 2 wks. Feel ok now.

I've always had problems assigning to the variables. It seems that whenever I do that, whatever I had that worked, comes up with an error. I'll find a good training file to help me with that and improve. As far as Selecting goes, i guess I misunderstood. Someone did tell me to drop my "Select" and use "Activate" instead. In the future I'll try to go around it.

Anyway. I'm including the code that I'm having trouble with "Pasting". There are Rem statements throughout explaining everything that's going on.

I really appreciate your help.

Thanks JimmyB

Sub RecipeMoveToEdit()

Dim Strt
Dim TopLft
Dim BotRt
Dim LftLstT
Dim LftLstB
Dim Gree
Dim GrLin
Dim SndTo
Dim SndRng

        Sheets("Recipies Data").Activate ' A block of data with alpha & numeric content has been previously placed on this 'Recipies Data' Sheet
        

        Set Strt = ActiveCell  ' User is instructed to choose a specific cell to trigger the move back into the original sheet
                               '     thus making that chosen cell as the Active Cell (Strt)
        Set TopLft = Strt.Offset(-12, 0)  ' With the active cell we are setting the top left cell of the block by (Offset)
MsgBox TopLft.Address
        Set BotRt = Strt.Offset(0, 11)    ' With the active cell again we are setting the bottom right cell (offset)
MsgBox BotRt.Address

        
'This block is external from the problem block that I'm trying to cut and paste.  There is no problem with this process
        Set LftLstT = TopLft.Offset(0, -1)  ' This sets the 1st cell of a list that is necessary on this sheet but not needed if the block _
                                                is returned to the original sheet.  It is used only so the filter will pick up _
                                                all of the rows in the list
        Set LftLstB = Strt.Offset(0, -1)   'This sets up the last cell of the above list
        Set Gree = Strt.Offset(1, 0)
        Set SndRng = Range(TopLft.Address, BotRt.Address)
        Range(LftLstT, LftLstB).ClearContents
        GrLin = Gree.Row
        ActiveSheet.Rows(GrLin).Delete Shift:=xlUp
        
        ' This block works perfectly
 'End of block
 
 
        Range(TopLft.Address, BotRt.Address).Cut  'This identifies the block that needs to be cut from 'Recipies Data' sheeet _
                                                    and pasted in 'Values for Meals' _
                                                    The block pf cells that this pics, is exactly what it should be _
                                                    Also It's on the clipboard _
                                                    But it won't paste _
                                                    Error: "Object doesn't support property or method"

    With ThisWorkbook.Sheets("VALUES for MEALS").Range("N4")
        .Paste
    End With
End Sub

Hi Logit

It didn't work. Sure seems to me that it should have.

I get the error: Object doesn't support this property or method

Hi. I'm having a problem with pasting a range of cells from one sheet to another. I'm trying every variation that I can think of and nothing works. The whole sub works perfectly except the paste at the very end of the sub. Here's the code. Appreciate any help You can give me....Paste Method of Worksheet Class Failed.

Thanks so much

JimmyB

Sub RecipeMoveToEdit()

Dim Strt
Dim TopLft
Dim BotRt
Dim LftLstT
Dim LftLstB
Dim Gree
Dim GrLin
Dim SndTo
Dim SndRng

        Sheets("Recipies Data").Activate
        Set Strt = ActiveCell
        Set TopLft = Strt.Offset(-12, 0)
MsgBox TopLft.Address
        Set BotRt = Strt.Offset(0, 11)
MsgBox BotRt.Address
        Set LftLstT = TopLft.Offset(0, -1)

        Set LftLstB = Strt.Offset(0, -1)

        Set Gree = Strt.Offset(1, 0)
        Set SndRng = Range(TopLft.Address, BotRt.Address)
        Range(LftLstT, LftLstB).ClearContents
        
        GrLin = Gree.Row
        ActiveSheet.Rows(GrLin).Delete Shift:=xlUp
        
        Range(TopLft.Address, BotRt.Address).Cut
   
        Sheets("VALUES for MEALS").Activate
        Set SndTo = ThisWorkbook.Sheets("VALUES for MEALS").Range("N4")
        Range(SndTo.Address).Select
MsgBox SndTo.Address
        
    With Range(SndTo.Address)
        ActiveSheet.Paste
    End With

End Sub

Thanks Roy

Yup Works great.

Thanks so much Sobi

Really appreciate it

JImmyB

Hi. I'm having an issue. with my program. If I click on my button to activate my YouTube video...AND my internet is not up, my program locks up into 'Break Mode'. At that point I must save, shutdown & reopen the program. That's fine for me, but I'll have a lot of other users of the program that won't appreciate this. Is there a line or two of code that I can incorporate into my code to make this more forgivable, so the user can just be prompted to turn on the internet?

The code that activates is below

Thanks a ton for your help

BTW can you tell me how to change from Unresolved to Resolved after my issue has been taken care of...Thanks again

  Sub HyperYTHome()
          
Dim str As String
        str = "https://youtu.be/SDou13wHzE4"
        ActiveWorkbook.FollowHyperlink Address:=str, NewWindow:=True
End Sub 

Awesome job Roy.

The code to change my deletion from Row to specific range was bang on. I also streamlined my 'with' statements as you've suggested, with success. Tomorrow I'll streamline it even further with your recommendation to use the array in the above code. I can also adapt the array syntax in a few other areas of my program. Great job.

Very much appreciate the help...all of it quite useful

BTW... No the row numbers are not the same. Each sheet is sorted to different columns. Calorie sheet sorted to amount of calories on each food item (lowest to highest), TransFat sorted to amount of transfat (lowest to highest)...an so on. So the rows of food items are all over the map.

It's 2am here. soooo g'nite

Thanks again Roy

JimmyB

Thanks Roy. This looks perfect. I'll work on it tonight if i can or tomorrow for sure.

Thanks JimmyB

I'm gone for the day and will check back tonight if you get a chance to reply

Thanks again

Hi Roy. Thanks for your quick reply.

I did receive the code from someone at Ozgrid and tailored it to fit my requirement of deletion. I'm sure that my adaptations of the code is rudimentary at best, but I made it work. (and it worked perfectly for what I needed). An array would probably condense the length of the code, but I'm not sure how to proceed with that. I've included the full sub below. If you do take the time to help, please take note that I only want to delete up to column "L" (my initial request)

Thanks again and have a great day

Any help will be appreciated

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        '''When cell in column "A" in Values for meals is double clicked this sub _
            causes all adjacent sheets to also delete the same item

        If Target.Column <> 1 Then Exit Sub
        If Target.Column > 0 Then
 Dim Result
 
            Result = MsgBox("You are about to delete an item from your food listing" & vbNewLine & vbNewLine & _
            "  YES  = DELETE THE ITEM" & vbNewLine & vbNewLine & "  NO  = DO NOT  DELETE", vbExclamation + vbYesNo, "CONFIRM DELETION")
        If Result = vbNo Then
            Exit Sub
        Else:
        '''The above block prompts the user to confirm deletion of complete food item
        
         
Dim x, I As Long
Dim ws As Worksheet
Dim LastRow As Long

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual
            
    With Target
            x = Application.Match(.Value, Sheets("Calories").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Calories").Rows(x & ":" & x).Delete Shift:=xlUp
    End With

    With Target
            x = Application.Match(.Value, Sheets("Tot Fat").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Tot Fat").Rows(x & ":" & x).Delete Shift:=xlUp
    End With

    With Target
            x = Application.Match(.Value, Sheets("Trans Fat").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Trans Fat").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Cholesterol").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Cholesterol").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Sodium").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Sodium").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Carbs").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Carbs").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Fibre").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Fibre").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Sugar").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Sugar").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target
            x = Application.Match(.Value, Sheets("Protein").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("Protein").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 
    With Target

            x = Application.Match(.Value, Sheets("VALUES for MEALS").Range("A1:A1000"), 0)
            If Not IsError(x) Then Sheets("VALUES for MEALS").Rows(x & ":" & x).Delete Shift:=xlUp
    End With
 

        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = False
        Cancel = True
        
        End If
        End If
        
End Sub

Hi. Struggling with a little problem. In my program I choose a particular cell and double click it. this activates the sub which in turn deletes the complete row. That is exactly what it was designed to do, but now I've added a feature to the program which is housed to the right of the cells that are to be deleted. Since it is deleting the complete row, it messes up my new feature. Below is the portion of code:

X is the cell in column 'A' that is activated.

I need it to delete only the cells in row x from column 'A' to 'L' then shift:=xlUp

Any help will be greatly appreciated

Thanks

JimmyB

With Target
            x = Application.Match(.Value, Sheets("VALUES for MEALS").Range("A1:A1000"), 0)
        If Not IsError(x) Then Sheets("VALUES for MEALS").Rows(x & ":" & x).Delete Shift:=xlUp
    End With

Thanks Rory...but I couldn't find anything there. What did you see that I'm missing?

Thanks JimmyB

Good Day

I'm having a problem with a program I created using VBA. It works great on all of my computers. (I have 3 laptops: HP, Dell & Toshiba Satelite...& 1 desktop HP). I sent a copy of the program through our shared 'Dropbox' folder, to my daughter. She copied it to the desktop folder of her laptop and it isn't working properly... the macros are disabled. All errors seem related to 'not being able to run the macros as they may be disabled' etc. The program does open but none of the macros work. We get the 'Security Warning...and we checked the box "Enable this Content"...so that isn't the issue. I checked her "Excel" settings <Trust Center><Trust Center Settings><Macro & ActiveX settings>. They are the same as mine which allows macros, with permissions. The "Trust access to VBA object model" is also checked. I even set the folder that houses the program, as a "Trusted Location".

Is there some setting in Windows 10 that disallows macros...BTW we both are using Windows 10 & Excel 2007. Her antivirus is Kaspersky (free) & I'm using AVG (Paid). Both hers and my firewalls are activated.

Any help will be greatly appreciated.

Thanks a ton

JimmyB