Solved

Rewrite an old MacroPage Sub

Posted on 2014-01-19
18
302 Views
Last Modified: 2014-02-12
Need help rewriting this to VBA..   it is an old MacroPg written in an old version of Excel =R=

Controled Add
=ROW(ACTIVE.CELL())
' Want to add here, if column B of active row is not = to today exit sub
'has to be equal to todays date.  Using date format:  1/19/14 7:00:38


'considered using cut instead of paste, so I do not have to define, then go back and delete.
' but because it sets a marker of where the row is.
'the cutting out can effected the rest of the formulas below it, lets keep it the same.

=SELECT("r"&E10&"c1:r"&E10&"c17")   'select C1 thru c17 to copy,
' some columns in this range are hidden  
'E10 refers to the cell that the  =ROW(ACTIVE.CELL()) was in above.

=DEFINE.NAME("RowToCopyToTop")
=COPY()
=SELECT("r7c2")
=PASTE()
=SELECT(RowToCopyToTop)
=ROWS(EDIT.DELETE(3))

=ROW(ACTIVE.CELL())  'after delete there is a new row actice.
=SELECT("r"&E19&"c2")  'E19 refers to the cell in the macropg that the row above is.
=SELECT(OFFSET(ACTIVE.CELL(),-1,0))
=FORMULA("=r[1]c[8]")  'correct the formula to point to the correct row above it.

'reformats the inserted row back at the top in row 7
=SELECT("r7c11")
=CLEAR()
=FORMULA("Task restarted")

=SELECT("r8c10")
=FORMULA("=NOW()")
=COPY()
=PASTE()
=PASTE.SPECIAL(3,1,FALSE,FALSE)

=SELECT("r7c5")
=COPY()
=SELECT("r7c6")
=PASTE()
=SELECT("r7c5")
=FORMULA("=NOW()-r[]c[-3]+r[]c[1]")
=SELECT("r7c1")
=RETURN()
0
Comment
Question by:RWayneH
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 11
  • 7
18 Comments
 
LVL 43

Expert Comment

by:Rob
ID: 39792889
Hard to convert without sample data but try this and let me know

'=ROW(ACTIVE.CELL())
' Want to add here, if column B of active row is not = to today exit sub
'has to be equal to todays date.  Using date format:  1/19/14 7:00:38
If Day(ActiveCell.Value) <> Day(Now()) Then
    Exit Sub
End If


'considered using cut instead of paste, so I do not have to define, then go back and delete.
' but because it sets a marker of where the row is.
'the cutting out can effected the rest of the formulas below it, lets keep it the same.
'=SELECT("r"&E10&"c1:r"&E10&"c17")   'select C1 thru c17 to copy,
Range("C1:C17").Select
' some columns in this range are hidden
'E10 refers to the cell that the  =ROW(ACTIVE.CELL()) was in above.

'=DEFINE.NAME("RowToCopyToTop")
'=COPY()
Application.CutCopyMode = False
Selection.Copy
'=SELECT("r7c2")
Cells(7, 2).Select
'=PASTE()
ActiveCell.PasteSpecial xlPasteAll
'=SELECT(RowToCopyToTop)
Range("C1:C3").Select
'=ROWS(EDIT.DELETE(3))
Selection.EntireRow.Delete
'=ROW(ACTIVE.CELL())  'after delete there is a new row actice.
'=SELECT("r"&E19&"c2")  'E19 refers to the cell in the macropg that the row above is.
Cells(Range("E19").Value, 2).Select
'=SELECT(OFFSET(ACTIVE.CELL(),-1,0))
ActiveCell.Cells(0, 1).Select
'=FORMULA("=r[1]c[8]")  'correct the formula to point to the correct row above it.
Selection.FormulaR1C1 = "=R[1]C[8]"
'reformats the inserted row back at the top in row 7
'=SELECT("r7c11")
Cells(7, 11).Select
'=CLEAR()
Selection.Clear
'=FORMULA("Task restarted")
Selection.Formula = "Task restarted"
'=SELECT("r8c10")
Cells(8, 10).Select
'=FORMULA("=NOW()")
Selection.Formula = "=NOW()"
'=COPY()
    Application.CutCopyMode = False
Selection.Copy
'=PASTE()
'=PASTE.SPECIAL(3,1,FALSE,FALSE)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'=SELECT("r7c5")
Cells(7, 5).Select
'=COPY()
    Application.CutCopyMode = False
    Selection.Copy
'=SELECT("r7c6")
Cells(7, 6).Select
'=PASTE()
Selection.PasteSpecial
'=SELECT("r7c5")
Cells(7, 5).Select
'=FORMULA("=NOW()-r[]c[-3]+r[]c[1]")
Selection.FormulaR1C1 = "=NOW()-RC[-3]+RC[1]"
'=SELECT("r7c1")
Cells(7, 1).Select
'=RETURN()
End Sub

Open in new window

0
 

Author Comment

by:RWayneH
ID: 39792927
It is difficult to read with all the old code..  On the first part were we use =ROW(ACTIVE.CELL())   the user will put there active cell anywhere on the line that they are restarting a timer on...  so your If statement referencing active.cell being equal to today is not quite going to do it....  It has read something like.  Whatever cell is selected or is the active cell, in that row the value in column B of that row needs to be today.

In Ln12, it is not cell c1 to ... it is column 1 thru column 17 of whatever row is selected

Second Ln13 cannot be absolute values either, it needs to point to the column range of the row selected..  so if the user click anywhere on row 13, it needs to copy that.

Ln17 defines the row and range to go back to it.

Lets get that part going.. the sample file does not have data in it that really applies, but I attached a copy anyway.  When loaded use Crtl+r to restart a task that is in the same day.
0
 

Author Comment

by:RWayneH
ID: 39792933
oops here is the sample file. -R-
TimeTracker.xls
0
Salesforce Has Never Been Easier

Improve and reinforce salesforce training & adoption using WalkMe's digital adoption platform. Start saving on costly employee training by creating fast intuitive Walk-Thrus for Salesforce. Claim your Free Account Now

 
LVL 43

Expert Comment

by:Rob
ID: 39792982
ok I've updated those formulas:

Sub TimeTrackerEE()
    '=ROW(ACTIVE.CELL())
    ' Want to add here, if column B of active row is not = to today exit sub
    'has to be equal to todays date.  Using date format:  1/19/14 7:00:38
    If Day(Range("B" & ActiveCell.Row).Value) <> Day(Now()) Then
        Exit Sub
    End If
    
    
    'considered using cut instead of paste, so I do not have to define, then go back and delete.
    ' but because it sets a marker of where the row is.
    'the cutting out can effected the rest of the formulas below it, lets keep it the same.
    '=SELECT("r"&E10&"c1:r"&E10&"c17")   'select C1 thru c17 to copy,
    Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 17)).Select
    ' some columns in this range are hidden
    'E10 refers to the cell that the  =ROW(ACTIVE.CELL()) was in above.
    
    '=DEFINE.NAME("RowToCopyToTop")
        ActiveWorkbook.Names.Add Name:="RowToCopyToTop", RefersTo:=Selection.Address
    '=COPY()
    Application.CutCopyMode = False
    Selection.Copy
    '=SELECT("r7c2")
    Cells(7, 2).Select
    '=PASTE()
    ActiveCell.PasteSpecial xlPasteAll
    '=SELECT(RowToCopyToTop)
    Application.Goto Reference:="RowToCopyToTop"
    '=ROWS(EDIT.DELETE(3))
    Selection.EntireRow.Delete
    '=ROW(ACTIVE.CELL())  'after delete there is a new row actice.
    '=SELECT("r"&E19&"c2")  'E19 refers to the cell in the macropg that the row above is.
    Cells(Range("E19").Value, 2).Select
    '=SELECT(OFFSET(ACTIVE.CELL(),-1,0))
    ActiveCell.Cells(0, 1).Select
    '=FORMULA("=r[1]c[8]")  'correct the formula to point to the correct row above it.
    Selection.FormulaR1C1 = "=R[1]C[8]"
    'reformats the inserted row back at the top in row 7
    '=SELECT("r7c11")
    Cells(7, 11).Select
    '=CLEAR()
    Selection.Clear
    '=FORMULA("Task restarted")
    Selection.Formula = "Task restarted"
    '=SELECT("r8c10")
    Cells(8, 10).Select
    '=FORMULA("=NOW()")
    Selection.Formula = "=NOW()"
    '=COPY()
        Application.CutCopyMode = False
    Selection.Copy
    '=PASTE()
    '=PASTE.SPECIAL(3,1,FALSE,FALSE)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    '=SELECT("r7c5")
    Cells(7, 5).Select
    '=COPY()
        Application.CutCopyMode = False
        Selection.Copy
    '=SELECT("r7c6")
    Cells(7, 6).Select
    '=PASTE()
    Selection.PasteSpecial
    '=SELECT("r7c5")
    Cells(7, 5).Select
    '=FORMULA("=NOW()-r[]c[-3]+r[]c[1]")
    Selection.FormulaR1C1 = "=NOW()-RC[-3]+RC[1]"
    '=SELECT("r7c1")
    Cells(7, 1).Select
    '=RETURN()
End Sub

Open in new window

0
 

Author Comment

by:RWayneH
ID: 39793019
failing to find the defined range or original row to delete.

Application.Goto Reference:="RowToCopyToTop"
    '=ROWS(EDIT.DELETE(3))
0
 
LVL 43

Expert Comment

by:Rob
ID: 39793036
I'm out at the moment but it'll be an easy fix.
While I think if it, that line to delete,  is it deleting 3 rows from the active cell down?
0
 

Author Comment

by:RWayneH
ID: 39793083
no it is just deleting the row... the (3) has something to do with a setting for entire row, or shift up??  in the old code it meant something...
0
 
LVL 43

Expert Comment

by:Rob
ID: 39793086
That's okay. I'll just delete the current row
0
 

Author Comment

by:RWayneH
ID: 39793097
yes it is the row that was copied up to the top, we do not need it anymore in it original location because it was copied up to the top of the page.  It is the row that the had the active cell in it at the beginning.
0
 
LVL 43

Expert Comment

by:Rob
ID: 39793206
Ok, I've run this is your workbook but I'm not sure if it does what you want:

Sub TimeTrackerEE()
    '=ROW(ACTIVE.CELL())
    ' Want to add here, if column B of active row is not = to today exit sub
    'has to be equal to todays date.  Using date format:  1/19/14 7:00:38
    If Day(Range("B" & ActiveCell.Row).Value) <> Day(Now()) Then
        Exit Sub
    End If
    
    
    'considered using cut instead of paste, so I do not have to define, then go back and delete.
    ' but because it sets a marker of where the row is.
    'the cutting out can effected the rest of the formulas below it, lets keep it the same.
    '=SELECT("r"&E10&"c1:r"&E10&"c17")   'select C1 thru c17 to copy,
    Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 17)).Select
    ' some columns in this range are hidden
    'E10 refers to the cell that the  =ROW(ACTIVE.CELL()) was in above.
    
    '=DEFINE.NAME("RowToCopyToTop")
    'ActiveWorkbook.Names.Add Name:="MyRob", RefersToR1C1:="=TaskTracker!R7C2:R7C11"
    ActiveWorkbook.Names.Add Name:="RowToCopyToTop", RefersTo:="=" & ActiveSheet.Name & "!" & Selection.Address
    '=COPY()
    Application.CutCopyMode = False
    Selection.Copy
    '=SELECT("r7c2")
    Cells(7, 2).Select
    '=PASTE()
    ActiveCell.PasteSpecial xlPasteAll
    '=SELECT(RowToCopyToTop)
    Application.Goto Reference:="RowToCopyToTop"
    '=ROWS(EDIT.DELETE(3))
    Selection.EntireRow.Delete
    '=ROW(ACTIVE.CELL())  'after delete there is a new row actice.
    '=SELECT("r"&E19&"c2")  'E19 refers to the cell in the macropg that the row above is.
    Cells(ActiveCell.Row, 2).Select
    '=SELECT(OFFSET(ACTIVE.CELL(),-1,0))
    ActiveCell.Cells(1, 1).Select
    '=FORMULA("=r[1]c[8]")  'correct the formula to point to the correct row above it.
    Selection.FormulaR1C1 = "=R[1]C[8]"
    'reformats the inserted row back at the top in row 7
    '=SELECT("r7c11")
    Cells(7, 11).Select
    '=CLEAR()
    Selection.Clear
    '=FORMULA("Task restarted")
    Selection.Formula = "Task restarted"
    '=SELECT("r8c10")
    Cells(8, 10).Select
    '=FORMULA("=NOW()")
    Selection.Formula = "=NOW()"
    '=COPY()
        Application.CutCopyMode = False
    Selection.Copy
    '=PASTE()
    '=PASTE.SPECIAL(3,1,FALSE,FALSE)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    '=SELECT("r7c5")
    Cells(7, 5).Select
    '=COPY()
        Application.CutCopyMode = False
        Selection.Copy
    '=SELECT("r7c6")
    Cells(7, 6).Select
    '=PASTE()
    Selection.PasteSpecial
    '=SELECT("r7c5")
    Cells(7, 5).Select
    '=FORMULA("=NOW()-r[]c[-3]+r[]c[1]")
    Selection.FormulaR1C1 = "=NOW()-RC[-3]+RC[1]"
    '=SELECT("r7c1")
    Cells(7, 1).Select
    '=RETURN()
End Sub

Open in new window

0
 

Author Comment

by:RWayneH
ID: 39793242
Can you use the feature that shows the line numbers... so I can point out where there is an issue?  Thanks. -R-
0
 

Author Comment

by:RWayneH
ID: 39793247
Nevermind I see they are there... I will reply in the morning...
0
 

Author Comment

by:RWayneH
ID: 39793261
Ln 25 needs to be Cells(7, 1).Select  so the fields line up.  After running the code I am not sure what line34 and 36 are doing... but it leaves a #ref error in the cell that needs the formula that is in line 38.  So when the original selected row is deleted, we need to replace a formula back into the cell that the delete row broke... is should make sense when running this in the sample.xlsx that I put out there....   after this it should be fine... Thanks. -R-  Decided to look closer at it now and not wait til morning. -R-
0
 
LVL 43

Accepted Solution

by:
Rob earned 500 total points
ID: 39793279
Don't know about line 34 and 36 either but this runs and works for me...

Sub TimeTrackerEE()
    '=ROW(ACTIVE.CELL())
    ' Want to add here, if column B of active row is not = to today exit sub
    'has to be equal to todays date.  Using date format:  1/19/14 7:00:38
    If Day(Range("B" & ActiveCell.Row).Value) <> Day(Now()) Then
        Exit Sub
    End If
    
    
    'considered using cut instead of paste, so I do not have to define, then go back and delete.
    ' but because it sets a marker of where the row is.
    'the cutting out can effected the rest of the formulas below it, lets keep it the same.
    '=SELECT("r"&E10&"c1:r"&E10&"c17")   'select C1 thru c17 to copy,
    Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 17)).Select
    ' some columns in this range are hidden
    'E10 refers to the cell that the  =ROW(ACTIVE.CELL()) was in above.
    
    '=DEFINE.NAME("RowToCopyToTop")
    'ActiveWorkbook.Names.Add Name:="MyRob", RefersToR1C1:="=TaskTracker!R7C2:R7C11"
    ActiveWorkbook.Names.Add Name:="RowToCopyToTop", RefersTo:="=" & ActiveSheet.Name & "!" & Selection.Address
    '=COPY()
    Application.CutCopyMode = False
    Selection.Copy
    '=SELECT("r7c2")
    Cells(7, 1).Select
    '=PASTE()
    ActiveCell.PasteSpecial xlPasteAll
    '=SELECT(RowToCopyToTop)
    Application.Goto Reference:="RowToCopyToTop"
    '=ROWS(EDIT.DELETE(3))
    Selection.EntireRow.Delete
    '=ROW(ACTIVE.CELL())  'after delete there is a new row actice.
    '=SELECT("r"&E19&"c2")  'E19 refers to the cell in the macropg that the row above is.
    Cells(ActiveCell.Row, 2).Select
    '=SELECT(OFFSET(ACTIVE.CELL(),-1,0))
    ActiveCell.Cells(1, 1).Select
    '=FORMULA("=r[1]c[8]")  'correct the formula to point to the correct row above it.
    Selection.FormulaR1C1 = "=R[1]C[8]"
    'reformats the inserted row back at the top in row 7
    '=SELECT("r7c11")
    Cells(7, 11).Select
    '=CLEAR()
    Selection.Clear
    '=FORMULA("Task restarted")
    Selection.Formula = "Task restarted"
    '=SELECT("r8c10")
    Cells(8, 10).Select
    '=FORMULA("=NOW()")
    Selection.Formula = "=NOW()"
    '=COPY()
        Application.CutCopyMode = False
    Selection.Copy
    '=PASTE()
    '=PASTE.SPECIAL(3,1,FALSE,FALSE)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    '=SELECT("r7c5")
    Cells(7, 5).Select
    '=COPY()
        Application.CutCopyMode = False
        Selection.Copy
    '=SELECT("r7c6")
    Cells(7, 6).Select
    '=PASTE()
    Selection.PasteSpecial
    '=SELECT("r7c5")
    Cells(7, 5).Select
    '=FORMULA("=NOW()-r[]c[-3]+r[]c[1]")
    Selection.FormulaR1C1 = "=NOW()-RC[-3]+RC[1]"
    '=SELECT("r7c1")
    Cells(7, 1).Select
    '=RETURN()
End Sub

Open in new window

0
 
LVL 43

Expert Comment

by:Rob
ID: 39793282
What timezone are you on? it's 2pm here so I may catch you first thing in your morning
0
 

Author Comment

by:RWayneH
ID: 39817759
Time zone is EST...  however I am still getting an error in column A...  I am going to add few lines to copy down the formula at the bottom of the sub, to see if that will correct it.  I think it may depend on if a given row has already been restarted or not.  It messes with other formulas in the sheet if one is not there..  I will post back when I am sure it works.. Thanks. -R-
0
 

Author Comment

by:RWayneH
ID: 39817810
I am testing the Windows scheduler based on the link provided above.  After creating a basic task, and completing it.  How do I recall or find it to make edits?
0
 

Author Closing Comment

by:RWayneH
ID: 39854468
Thanks. -R-
0

Featured Post

To Patch or not to Patch? That is the question!

Don't get caught out like thousands of others around the world in the recent Ransomware Fiasco!
Discuss..
- Why it's not a good idea to wait before Patching
- Sensible approaches to Patching discussed
- Add your feedback, comments and suggestions

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft Office Picture Manager is not included in Office 2013. This comes as a shock to users upgrading from earlier versions of Office, such as 2007 and 2010, where Picture Manager was included as a standard application. This article explains how…
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

732 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question