Solved

Rewrite an old MacroPage Sub

Posted on 2014-01-19
18
280 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
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
Ransomware: The New Cyber Threat & How to Stop It

This infographic explains ransomware, type of malware that blocks access to your files or your systems and holds them hostage until a ransom is paid. It also examines the different types of ransomware and explains what you can do to thwart this sinister online threat.  

 
LVL 42

Expert Comment

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

Expert Comment

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

Expert Comment

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

Expert Comment

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

Accepted Solution

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

Expert Comment

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

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

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…
This article will show you how to use shortcut menus in the Access run-time environment.
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

810 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