• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 317
  • Last Modified:

Rewrite an old MacroPage Sub

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
RWayneH
Asked:
RWayneH
  • 11
  • 7
1 Solution
 
RobOwner (Aidellio)Commented:
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
 
RWayneHAuthor Commented:
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
 
RWayneHAuthor Commented:
oops here is the sample file. -R-
TimeTracker.xls
0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
RobOwner (Aidellio)Commented:
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
 
RWayneHAuthor Commented:
failing to find the defined range or original row to delete.

Application.Goto Reference:="RowToCopyToTop"
    '=ROWS(EDIT.DELETE(3))
0
 
RobOwner (Aidellio)Commented:
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
 
RWayneHAuthor Commented:
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
 
RobOwner (Aidellio)Commented:
That's okay. I'll just delete the current row
0
 
RWayneHAuthor Commented:
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
 
RobOwner (Aidellio)Commented:
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
 
RWayneHAuthor Commented:
Can you use the feature that shows the line numbers... so I can point out where there is an issue?  Thanks. -R-
0
 
RWayneHAuthor Commented:
Nevermind I see they are there... I will reply in the morning...
0
 
RWayneHAuthor Commented:
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
 
RobOwner (Aidellio)Commented:
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
 
RobOwner (Aidellio)Commented:
What timezone are you on? it's 2pm here so I may catch you first thing in your morning
0
 
RWayneHAuthor Commented:
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
 
RWayneHAuthor Commented:
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
 
RWayneHAuthor Commented:
Thanks. -R-
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

  • 11
  • 7
Tackle projects and never again get stuck behind a technical roadblock.
Join Now