repost: looking for some code cleanup and help with screenupdate issue 2

[Somnolence81]

I am working on combining a macro that converts integers that are simulated to be in a time format, into an actual format( this one works, we have been using it for over 4 years with no trouble other than it is slow). and a new macro that checks for data in the columns A,Q,R,S,T,U,V and W adjacent to a selected range for blank or not, then autofills from the above row in said columns, assuming that the cell referenced in the selection also contains data, after reading a few answers I noticed a familiar mantra of not using the .select function. I have it at least three times per said column, and when I try to clean it up, I get any number of errors from range to object... The last scripting I did was over fifteen years ago and in a different language, so consider me a novice... I want to bind these macros to a hotkey so that they will both run sequentially and here is what I have so far:

'in Module 2:

Sub MasterCallMacros()
    Call NumberToTime
    Call ReturnSelection
End Sub

'in module 1:

Sub NumberToTime()
Application.ScreenUpdating = False
        Dim rCell As Range
        Dim iHours As Integer
        Dim iMins As Integer
        x = x
        For Each rCell In Selection
            If rCell.Value = "" Then x = x + 1
            If rCell.NumberFormat = "hh:mm" And rCell.Value = "" Then rCell.NumberFormat = "0#"":""##;@"
                x = x + 1
            If IsNumeric(rCell.Value) And Len(rCell.Value) > 0 And rCell.NumberFormat <> "hh:mm" Then
                iHours = rCell.Value \ 100
                iMins = rCell.Value Mod 100
                rCell.Value = (iHours + iMins / 60) / 24
                rCell.NumberFormat = "hh:mm"
            End If
        Next
Application.ScreenUpdating = True
End Sub

'in module 3:

[CODE]
Option Explicit
Sub ReturnSelection()
Application.ScreenUpdating = False
    Dim ActSheet As Worksheet
    Dim rCell As Range
    
    Set ActSheet = ActiveSheet
    Set rCell = Selection
    
        For Each rCell In Selection
            If Range("A" & (ActiveCell.Row)).Value <> "" Then
                ActSheet.Select
                rCell.Select
                Else
            If Range("A" & (ActiveCell.Row)).Value = "" Then
                Range("A" & (ActiveCell.Row)).Select
                ActiveCell.Offset(-1, 0).Select
                ActiveCell.Copy
                ActiveCell.Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            If Range("Q" & (ActiveCell.Row)).Value = "" Then
                Range("Q" & (ActiveCell.Row)).Select
                ActiveCell.Offset(-1, 0).Select
                ActiveCell.Copy
                ActiveCell.Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            If Range("R" & (ActiveCell.Row)).Value = "" Then
                Range("R" & (ActiveCell.Row)).Select
                ActiveCell.Offset(-1, 0).Select
                ActiveCell.Copy
                ActiveCell.Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            If Range("S" & (ActiveCell.Row)).Value = "" Then
                Range("S" & (ActiveCell.Row)).Select
                ActiveCell.Offset(-1, 0).Select
                ActiveCell.Copy
                ActiveCell.Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            If Range("T" & (ActiveCell.Row)).Value = "" Then
                Range("T" & (ActiveCell.Row)).Select
                ActiveCell.Offset(-1, 0).Select
                ActiveCell.Copy
                ActiveCell.Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            If Range("U" & (ActiveCell.Row)).Value = "" Then
                Range("U" & (ActiveCell.Row)).Select
                ActiveCell.Offset(-1, 0).Select
                ActiveCell.Copy
                ActiveCell.Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            If Range("V" & (ActiveCell.Row)).Value = "" Then
                Range("V" & (ActiveCell.Row)).Select
                ActiveCell.Offset(-1, 0).Select
                ActiveCell.Copy
                ActiveCell.Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            If Range("w" & (ActiveCell.Row)).Value = "" Then
                Range("w" & (ActiveCell.Row)).Select
                ActiveCell.Offset(-1, 0).Select
                ActiveCell.Copy
                ActiveCell.Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            End If
            End If
            End If
            End If
            End If
            End If
            End If
            End If
            End If
        Next
Application.ScreenUpdating = True
End Sub

Any help would be greatly appreciated, also when trying to combine the codes, aplication.screenupdate=false doesn't seem to work in any combination of in each macro, in only mastercall, or all of the above... any ideas? thanks in advance

 

[xlbo]

for example, this:

If Range("A" & (ActiveCell.Row)).Value = "" Then
                Range("A" & (ActiveCell.Row)).Select
                ActiveCell.Offset(-1, 0).Select
                ActiveCell.Copy
                ActiveCell.Offset(1, 0).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

can be changed to:

With ActiveCell

    If Range("A" & (.Row)).Value = "" Then
        Range("A" & (.Row)).Offset(-1, 0).Copy
        .PasteSpecial Paste:=xlPasteValues
    End If
End With

You do not need to move about on teh sheet to reference different cells

refer to a specific cell:
Range("A1")

refer to the cell above the specific cell
Range("A1").offset(-1,0)

refer to the cell below the specific cell
Range("A1").offset(1,0)

When you use offset, it effectively creates a new range object so to copy the cell above:

Range("A1").offset(-1,0).copy

and to paste to the cell below:

Range("A1").offset(1,0).paste

In general, anywhere you have a line ending in "select" and the next line starting with "selection" or "activecell", you can merge the lines:

Range("A1").offset(1,0).select
selection.copy

becomes

Range("A1").offset(1,0).copy

hopefully that gives you enough of an idea to go on

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[PHV]

Even simpler:

With ActiveCell
    If Range("A" & (.Row)).Value = "" Then
        Range("A" & (.Row)).Value = Range("A" & (.Row - 1)).Value
    End If
End With

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Somnolence81]

ok, so revised my code a bit but still have some bugs, sorry PHV, but yours kept giving me range errors, Geoff (by the way, are you per chance the same Geoff from RTP LLC? just curious) I'm still having problems with the screenupdate turning itself back on when I run from the MasterCallMacro sub, and having trouble figuring out how to just make the ReturnSelection end if the first active cell is empty. One thing I probably should have mentioned is that the range referred to is user selected in columns B,C,D, and E, and x# of rows based on manual input. Here is what I have right now as my revised code for the SelectReturn macro:

Sub ReturnSelection()
Application.ScreenUpdating = False
    Dim ActSheet As Worksheet
    Dim rCell As Range
    
    Set ActSheet = ActiveSheet
    Set rCell = Selection
    
        For Each rCell In Selection
            If ActiveCell.Value = "" Then
                ActSheet.Select
                rCell.Select
                rCell.Offset(1, 0).Activate
                End If
            With ActiveCell
                If Range("A" & (.Row)).Value = "" Then
                    Range("A" & (.Row)).Offset(-1, 0).Copy
                    Range("A" & (.Row)).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                End If
                If Range("Q" & (.Row)).Formula = "" Then
                    Range("Q" & (.Row)).Offset(-1, 0).Copy
                    Range("Q" & (.Row)).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                End If
                If Range("R" & (.Row)).Formula = "" Then
                    Range("R" & (.Row)).Offset(-1, 0).Copy
                    Range("R" & (.Row)).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                End If
                If Range("S" & (.Row)).Formula = "" Then
                    Range("S" & (.Row)).Offset(-1, 0).Copy
                    Range("S" & (.Row)).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                End If
                If Range("T" & (.Row)).Formula = "" Then
                    Range("T" & (.Row)).Offset(-1, 0).Copy
                    Range("T" & (.Row)).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                End If
                If Range("U" & (.Row)).Formula = "" Then
                    Range("U" & (.Row)).Offset(-1, 0).Copy
                    Range("U" & (.Row)).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                End If
                If Range("V" & (.Row)).Formula = "" Then
                    Range("V" & (.Row)).Offset(-1, 0).Copy
                    Range("V" & (.Row)).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                End If
                If Range("W" & (.Row)).Formula = "" Then
                    Range("W" & (.Row)).Offset(-1, 0).Copy
                    Range("W" & (.Row)).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                End If
            End With
            ActSheet.Select
            rCell.Select
            rCell.Offset(1, 0).Activate
        Next
    Application.ScreenUpdating = True
End Sub

Am I missing something with the screenupdating, it only turns back on when I try to use the MasterCallMacro, and given that I'm using Option Explicit, I'm a little fuzzy on how to make it just go to the next cell in column B of the original selection...

 

[SkipVought]

... checks for data in the columns A,Q,R,S,T,U,V and W adjacent to a selected range for blank or not, then autofills from the above row in said columns, assuming that the cell referenced in the selection also contains data,

This is a feature of TABLES in 2007 (Data > List > Create List in 2003 & earlier). If you have formulas in columns in your table, when you TAB into the NEW row, when you ENTER new data, your formulas are propogated to the new row. NO VBA REQUIRED!

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Somnolence81]

I realize that Skip, but the problem that I'm trying to circumvent is when others enter info into our spreadsheet, make small mistakes, and rather than correct them the right way, they use the easy way, which alters the formulas, ect. ect. I'm trying to idiot proof the spreadsheet to make reports that I submit based on said information faster, so that I don't have to spend 15-30 hours every week double checking the data. I want it to look like there is no difference, so that when they ask how it does that (the screenupdate=false) I can tell them it's magic. Trust me most of them would believe it with their level of computer literacy...

 

[xlbo]

Not sure what RTP LLC is so I'm guessing it's probably not me!!

In terms of screenupdating - try just removing all references to turning it back on as it will do that when the code finishes executing anyway - you don;t need to set it back to true.

I would also set it in the master sub rather than in each of the child subs...so long story short - set it false in master sub and don't do anything else with it!

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[Somnolence81]

thanks Geoff, wound up adding in a confirm box to separate the macros, last day of my work week and I'm running out of time. Also, removing the =true seems to have fixed the screenupdate problem.

 

[macropod]

hi Somnolence81,

Rather than having your code constantly checking the whether particular cells have any value or any formula with any format, either of which might not be valid, you would probably find it far quicker to simply loop through the ranges inserting the correct formulae and values, then applying the required formatting to each column or the whole range (depending whether they're all supposed to have the same format).

Some things that can also help when processing a column in which you're trying to change the contents of empty cells or cells that should contain formulae, is the 'SpecialCells' collection. Constants in that collection include:

Type constants
xlCellTypeBlanks. Empty cells
xlCellTypeConstants. Cells containing constants
xlCellTypeFormulas. Cells containing formulas
xlCellTypeVisible. All visible cells
Value constants
xlErrors
xlLogical
xlNumbers
xlTextValues

Using these in-built tools can be far faster than testing whether a cell is empty (xlCellTypeBlanks) when you know it should have something or has text or a number (xlCellTypeConstants) when it should have a formula.


Cheers
[MS MVP - Word]

 

[Somnolence81]

Wow, thanks macropod, I'll start playing around with those and see how I might be able to integrate them, unfortunatly for the time being I forgot the first rule in trying to idiot proof anything: someone can always build a better idiot... *smacks forehead*