Solved

Rewrite an old MacroPage Sub

Posted on 2014-01-19
18
251 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
  • 11
  • 7
18 Comments
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
Comment Utility
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
Comment Utility
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
Comment Utility
oops here is the sample file. -R-
TimeTracker.xls
0
 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
Comment Utility
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
Comment Utility
failing to find the defined range or original row to delete.

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

Expert Comment

by:Rob Jurd, EE MVE
Comment Utility
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
Comment Utility
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 42

Expert Comment

by:Rob Jurd, EE MVE
Comment Utility
That's okay. I'll just delete the current row
0
 

Author Comment

by:RWayneH
Comment Utility
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 42

Expert Comment

by:Rob Jurd, EE MVE
Comment Utility
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
Comment Utility
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
Comment Utility
Nevermind I see they are there... I will reply in the morning...
0
 

Author Comment

by:RWayneH
Comment Utility
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 42

Accepted Solution

by:
Rob Jurd, EE MVE earned 500 total points
Comment Utility
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 42

Expert Comment

by:Rob Jurd, EE MVE
Comment Utility
What timezone are you on? it's 2pm here so I may catch you first thing in your morning
0
 

Author Comment

by:RWayneH
Comment Utility
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
Comment Utility
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
Comment Utility
Thanks. -R-
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Using Word 2013, I was experiencing some incredible lag when typing.  Here's what worked for me....
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

771 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

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now