macro help please
I have a macro that I'd like to limit the pages it can work on.
Sub columnremove() Dim myRng As Range Set myRng = ActiveSheet.Rows(4) 'for rows that have 0's or blanks in column A 'set myRng = activesheet.range("a:a") With myRng .Replace What:=0, Replacement:="", LookAt:=xlWhole On Error Resume Next .Cells.SpecialCells(xlCellTypeBlanks).EntireColumn .Delete On Error GoTo 0 End With End Sub If i click it, and I am on wrong page it can ruin alot of work, I have only 3 pages it can work on, Month One, Month Two and Month Three. Can this macro be made to "check" if its in one of those pages and not fire, or give an error message if it is not? Ryk |
macro help please
One way:
Option Explicit Sub columnremove() Dim myRng As Range Select Case LCase(ActiveSheet.Name) Case Is = LCase("Month One"), LCase("Month Two"), LCase("Month Three") Set myRng = ActiveSheet.Rows(4) 'for rows that have 0's or blanks in column A 'set myRng = activesheet.range("a:a") With myRng .Replace What:=0, Replacement:="", LookAt:=xlWhole On Error Resume Next .Cells.SpecialCells(xlCellTypeBlanks).EntireColumn .Delete On Error GoTo 0 End With Case Else MsgBox "Please activate the correct sheet first!" End Select End Sub Ryk wrote: I have a macro that I'd like to limit the pages it can work on. Sub columnremove() Dim myRng As Range Set myRng = ActiveSheet.Rows(4) 'for rows that have 0's or blanks in column A 'set myRng = activesheet.range("a:a") With myRng .Replace What:=0, Replacement:="", LookAt:=xlWhole On Error Resume Next .Cells.SpecialCells(xlCellTypeBlanks).EntireColumn .Delete On Error GoTo 0 End With End Sub If i click it, and I am on wrong page it can ruin alot of work, I have only 3 pages it can work on, Month One, Month Two and Month Three. Can this macro be made to "check" if its in one of those pages and not fire, or give an error message if it is not? Ryk -- Dave Peterson |
macro help please
Beautiful Dave! Worked like a charm! Hopefully I can sneak in a second request. After adding that and talking with a co-worker, I came to realize we only have one other area to address in making the program safe for multi-user use. I'll be looking into it, but can we make the saved main program open up and right off the bat and request the user save it as a different name so the source stays safe? Maybe make it so they have to save it as a different name or it won't work. I assume I need find start code, and try and get the code to check the filename, if its the source name ask to save, if its not then it opens no problem. Anyways Dave, this is I think your third major help given to me, you make me look awful smart, and that is hard to do. Cheers Dave (AKA Ryk) |
macro help please
If I don't want users to save over my original workbook, I'll use windows
explorer and mark it readonly. It stops most of the problems. But I do keep a backup just in case. But you could use Auto_Open() to do what you want. Option Explicit Sub Auto_Open() Dim Resp As Long Resp = MsgBox(Prompt:="Do you want to save this as a new name?", _ Buttons:=vbYesNo) If Resp = vbYes Then Application.Dialogs(xlDialogSaveAs).Show End If End Sub Ryk wrote: Beautiful Dave! Worked like a charm! Hopefully I can sneak in a second request. After adding that and talking with a co-worker, I came to realize we only have one other area to address in making the program safe for multi-user use. I'll be looking into it, but can we make the saved main program open up and right off the bat and request the user save it as a different name so the source stays safe? Maybe make it so they have to save it as a different name or it won't work. I assume I need find start code, and try and get the code to check the filename, if its the source name ask to save, if its not then it opens no problem. Anyways Dave, this is I think your third major help given to me, you make me look awful smart, and that is hard to do. Cheers Dave (AKA Ryk) -- Dave Peterson |
macro help please
Dave, if i use that, can i set that to only work on original file? We do alot of work with this, and sometimes its several days of work, I'd hate to have them need save as a different name each time, only wish to protect original. Dave (AKA Ryk) |
macro help please
Opps, as in set it to look for file name as well, like "Hard Copy"? If its Hard Copy, it asks to save as different name, if not it opens fine. |
macro help please
Option Explicit
Sub Auto_Open() Dim Resp As Long if lcase(thisworkbook.name) like "*hard copy*" then Resp = MsgBox(Prompt:="Do you want to save this as a new name?", _ Buttons:=vbYesNo) If Resp = vbYes Then Application.Dialogs(xlDialogSaveAs).Show End If end if End Sub Ryk wrote: Opps, as in set it to look for file name as well, like "Hard Copy"? If its Hard Copy, it asks to save as different name, if not it opens fine. -- Dave Peterson |
macro help please
Well, I think that all works, gonna try it a few times. As I am new to posting here and have not be explained the rules, if I have further questions, should I just keep adding to this one or post a new one? other question probably easy enough tho, i am using a row highlighter.... Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Const cnNUMCOLS As Long = 256 Const cnHIGHLIGHTCOLOR As Long = 36 'default lt. yellow Static rOld As Range Static nColorIndices(1 To cnNUMCOLS) As Long Dim i As Long If Not rOld Is Nothing Then 'Restore color indices With rOld.Cells If .Row = ActiveCell.Row Then Exit Sub 'same row, don't restore For i = 1 To cnNUMCOLS .Item(i).Interior.ColorIndex = nColorIndices(i) Next i End With End If Set rOld = Cells(ActiveCell.Row, 1).Resize(1, cnNUMCOLS) With rOld For i = 1 To cnNUMCOLS nColorIndices(i) = .Item(i).Interior.ColorIndex Next i .Interior.ColorIndex = cnHIGHLIGHTCOLOR End With End Sub This works just fine, put I have made a copy macro and this interferes with it a bit, Can i make buttons, that turn a macro on or off? If so i'd just add the off part to existing... hmmmmmm, i'll add the copy macro as well, just in case it can be added to shut off the macro while it copies. Sub copy1() ' ' copy1 Macro ' Macro recorded 8/22/2006 by ryk' ' Keyboard Shortcut: Ctrl+o ' Range("A3:AX1006").Select Selection.Copy Sheets("Month One").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Month One").Select Range("A1").Select Selection.Copy Sheets("Month One").Select Range("A1").Select ActiveSheet.Paste Range("B6:B1006").SpecialCells(xlCellTypeBlanks).E ntireRow.Delete Sheets("Suggestions").Select Range("A5:Z1000").Select Selection.Copy Sheets("Suggested Changes").Select Range("A1").Select mycell = Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & mycell).Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.Replace What:="", Replacement:="$$$$$", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace What:="$$$$$", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False mycell = Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & mycell).Select End Sub If I cannot do on/off for macro I can lose the highlighter, it just helps because we spend alot of hours a week staring at this program hehe. More important the copy works, as we remove all the formulas so we can send out smaller sized files. Dave, if you answer this, please enlighten me on posting politeness if I am doing this wrong, as I have really gained alot and don't wish to **** anyone off heheh. Many thanks for what you have helped me with though, i hope you get paid somehow to do this. Dave |
macro help please
Ryk
Dave does get paid. His invoice will arrive at your residence within 5 working days. Or didn't you know about that aspect of these news groups<g Gord Dibben MS Excel MVP On 17 Sep 2006 18:55:41 -0700, "Ryk" wrote: Many thanks for what you have helped me with though, i hope you get paid somehow to do this. |
macro help please
One way around a problem like this is to not select ranges. But the bad news is
that excel sees a .pastespecial as a selection change. Same thing with the specialcells stuff. So you could tell excel to stop monitoring events (like selection changes) right before you change selection--and tell it to start again when you're done. Option Explicit Sub copy1() Dim DestCell As Range Dim RngToCopy As Range With ActiveSheet Set RngToCopy = .Range("A3:AX1006") End With With Worksheets("Month One") Set DestCell = .Range("a3") End With RngToCopy.Copy With DestCell Application.EnableEvents = False .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.EnableEvents = True End With Application.EnableEvents = False Sheets("Month One").Range("B6:B1006") _ .SpecialCells(xlCellTypeBlanks).EntireRow.Delete Application.EnableEvents = True With Worksheets("suggestions") Set RngToCopy = .Range("a5:z1000") End With With Worksheets("Suggested Changes") Set DestCell = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With RngToCopy.Copy With DestCell Application.EnableEvents = False .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.EnableEvents = True End With With DestCell.Resize(RngToCopy.Rows.Count, RngToCopy.Columns.Count) .Replace What:="", Replacement:="$$$$$", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False .Replace What:="$$$$$", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False End With 'keep the events enabled here! With Worksheets("suggested Changes") Application.Goto .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) End With End Sub ============ You could actually just turn event monitoring off at the top and and then turn it back on at the bottom. But as a personal preference, I usually (depending on the mood I'm in!) like to toggle it off right before it would have fired and turn it back on right after I'm done hiding from that event. I think that it makes it a little easier to steal code from old projects, too. I won't miss what I need when I copy|Paste. ============ And as newsgroup response, I think it's better to start a new thread when the original question is resolved--but not before. I (as well as most regulars) hate seeing a new post when there's an active thread elsewhere. ============ And I'll leave any remuneration discussions between you and my financial manager, Gord! Ryk wrote: Well, I think that all works, gonna try it a few times. As I am new to posting here and have not be explained the rules, if I have further questions, should I just keep adding to this one or post a new one? other question probably easy enough tho, i am using a row highlighter.... Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Const cnNUMCOLS As Long = 256 Const cnHIGHLIGHTCOLOR As Long = 36 'default lt. yellow Static rOld As Range Static nColorIndices(1 To cnNUMCOLS) As Long Dim i As Long If Not rOld Is Nothing Then 'Restore color indices With rOld.Cells If .Row = ActiveCell.Row Then Exit Sub 'same row, don't restore For i = 1 To cnNUMCOLS .Item(i).Interior.ColorIndex = nColorIndices(i) Next i End With End If Set rOld = Cells(ActiveCell.Row, 1).Resize(1, cnNUMCOLS) With rOld For i = 1 To cnNUMCOLS nColorIndices(i) = .Item(i).Interior.ColorIndex Next i .Interior.ColorIndex = cnHIGHLIGHTCOLOR End With End Sub This works just fine, put I have made a copy macro and this interferes with it a bit, Can i make buttons, that turn a macro on or off? If so i'd just add the off part to existing... hmmmmmm, i'll add the copy macro as well, just in case it can be added to shut off the macro while it copies. Sub copy1() ' ' copy1 Macro ' Macro recorded 8/22/2006 by ryk' ' Keyboard Shortcut: Ctrl+o ' Range("A3:AX1006").Select Selection.Copy Sheets("Month One").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Month One").Select Range("A1").Select Selection.Copy Sheets("Month One").Select Range("A1").Select ActiveSheet.Paste Range("B6:B1006").SpecialCells(xlCellTypeBlanks).E ntireRow.Delete Sheets("Suggestions").Select Range("A5:Z1000").Select Selection.Copy Sheets("Suggested Changes").Select Range("A1").Select mycell = Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & mycell).Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.Replace What:="", Replacement:="$$$$$", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Selection.Replace What:="$$$$$", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False mycell = Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & mycell).Select End Sub If I cannot do on/off for macro I can lose the highlighter, it just helps because we spend alot of hours a week staring at this program hehe. More important the copy works, as we remove all the formulas so we can send out smaller sized files. Dave, if you answer this, please enlighten me on posting politeness if I am doing this wrong, as I have really gained alot and don't wish to **** anyone off heheh. Many thanks for what you have helped me with though, i hope you get paid somehow to do this. Dave -- Dave Peterson |
macro help please
Ok Dave, I plugged that in but its not working. It seems to be selecting Month one before it shuts off the macro, because the line highlighter uses yellow, and row 3 copies as yellow now. But I actually did try too fix it, no worky. it looks to me like the events thingy is not shutting off. Hmmm hold on a sec.... Can we limit the rowliner to working in only row 6 to 1006? it seems it is only affecting row 3 now, makes it copy yellow, and i find out I cannot change fill colors back, because rowliner code. Maybe rowliner too much a pain. Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Const cnNUMCOLS As Long = 256 Const cnHIGHLIGHTCOLOR As Long = 36 'default lt. yellow Static rOld As Range Static nColorIndices(1 To cnNUMCOLS) As Long Dim i As Long If Not rOld Is Nothing Then 'Restore color indices With rOld.Cells If .Row = ActiveCell.Row Then Exit Sub 'same row, don't restore For i = 1 To cnNUMCOLS .Item(i).Interior.ColorIndex = nColorIndices(i) Next i End With End If Set rOld = Cells(ActiveCell.Row, 1).Resize(1, cnNUMCOLS) With rOld For i = 1 To cnNUMCOLS nColorIndices(i) = .Item(i).Interior.ColorIndex Next i .Interior.ColorIndex = cnHIGHLIGHTCOLOR End With End Sub Dave as for the renumeration, I'll email you a beer hehe |
macro help please
First, the events thingy did turn off for me. If you put a break point in the
code, can you step through it and watch what code is executed. And you can add a check like this: if intersect(target, me.range("6:1006")) is nothing then exit sub end if At the top of the _selectionchange code. Ryk wrote: Ok Dave, I plugged that in but its not working. It seems to be selecting Month one before it shuts off the macro, because the line highlighter uses yellow, and row 3 copies as yellow now. But I actually did try too fix it, no worky. it looks to me like the events thingy is not shutting off. Hmmm hold on a sec.... Can we limit the rowliner to working in only row 6 to 1006? it seems it is only affecting row 3 now, makes it copy yellow, and i find out I cannot change fill colors back, because rowliner code. Maybe rowliner too much a pain. Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Const cnNUMCOLS As Long = 256 Const cnHIGHLIGHTCOLOR As Long = 36 'default lt. yellow Static rOld As Range Static nColorIndices(1 To cnNUMCOLS) As Long Dim i As Long If Not rOld Is Nothing Then 'Restore color indices With rOld.Cells If .Row = ActiveCell.Row Then Exit Sub 'same row, don't restore For i = 1 To cnNUMCOLS .Item(i).Interior.ColorIndex = nColorIndices(i) Next i End With End If Set rOld = Cells(ActiveCell.Row, 1).Resize(1, cnNUMCOLS) With rOld For i = 1 To cnNUMCOLS nColorIndices(i) = .Item(i).Interior.ColorIndex Next i .Interior.ColorIndex = cnHIGHLIGHTCOLOR End With End Sub Dave as for the renumeration, I'll email you a beer hehe -- Dave Peterson |
All times are GMT +1. The time now is 03:58 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com