Change vba to allow macro to fill to last line

[Chris Turner]

I recorded this macro in an excel workbook I use at my place of work. The number of rows will vary from day to day. The recorded number of rows was 200. I want the code to fill down to the last cell in the column Q based on the number of cells with values in column B. Appreciate any help.

>> Use Code -tags <<

Sub ScrapInsert()
'
' ScrapInsert Macro
'
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveWindow.SmallScroll Down:=-6
    Sheets("Sheet7").Select
    Range("B23").Select
    Sheets("Daily Update").Select
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-4]=""Production Recorded"",RC[-3]>0),RC[-1],0)"
    Range("Q2").Select
    ActiveWindow.SmallScroll Down:=-6
    Range("Q1").Select
    Selection.AutoFill Destination:=Range("Q1:Q200")
    Range("Q1:Q200").Select
    Selection.Copy
    Range("P1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("Q:Q").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A1").Select
End Sub

 

[vletm]

Chris Turner
Could this do ... something same?
I 'cleaned some lines' from Your code.
I added 'LastRow' to find out Your 200 (=number of rows).
Without any file, it's challenge to test.

Sub ScrapInsert()
'' ScrapInsert Macro'  
    Columns("Q:Q").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheets("Daily Update").Select
   
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

    Range("Q1").FormulaR1C1 = "=IF(AND(RC[-4]=""Production Recorded"",RC[-3]>0),RC[-1],0)"
    Range("Q1").AutoFill Destination:=Range("Q1:Q"&LastRow)
    Range("Q1:Q"&LastRow).Copy
    Range("P1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Columns("Q:Q").Delete Shift:=xlToLeft
    Application.CutCopyMode = False
    Range("A1").Select
End Sub

 

[Chris Turner]

Thanks for your work on the code. I tried it and it stopped working at line with Count (see below):

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

I have added a sample of the data download I am working with. The ERP we use duplicates the values in Column N (see highlighted values). The purpose of the vba is to retain the value in Column N if there is a value greater than zero in Column P. If this statement is not true, and the value in Column P is zero, it removes the duplicate values in the Column N and replace them with zero (no value).

I want to perform the action in the code down to the last cell in Column N based on the number of rows/cells with a time value in Column D. I hope this helps. I appreciate any help.

 

[vletm]

Chris Turner
Yes ... sorry
That part should be ...

    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    End With

Your sample file ... hmm?
What would be name of Your 'start sheet'? ... from You're running Your macro?
Where are 'Sheet7'- and 'Daily Update'-sheets?
Your 'recording' has those ... but Your sample file not ... hmm?
... is that 'correct'-file?

I didn't start to guess ... what are You doing?
... but if that is something like =if(and(a,b,c,d))
then that formula would do otherways.
I didn't start to think that more!

 

[Chris Turner]

Sorry for the confusion. The the sample file is the "Daily Update" sheet.

'Sheet 7' is a single sheet with this formula in cell B23: =IF(AND(M1="Production Recorded",N1>0),P1,0)

The macro goes to 'Sheet 7' and copies the formula and pastes it into cell Q1 on the 'Daily Update' sheet and then fills the formula all the way down Column Q. I want the macro to copy the formula down to the last row in the sheet. I wanted to get it to do this action based on the time values in Column D because I know that all the cells in Column D have values down to the last row. I hope this helps.

 

[vletm]

Chris Turner
Okay ... those are also sheet sensitive.

Maybe this would do eg this way ...

Press [ Do It ]-button
> 1st it makes safe copy
> 2nd it solves almost Your named formula ... it would show only values over 0!

Is the result, something that You're looking for?

 

[Chris Turner]

That appears to be correct, but I do not have a button for the macro in my original workbook and the would macro remove the original column with the duplicate values.

 

[vletm]

Chris Turner
Result is Okay ...?
You can make that button to Your workbook Yourself or
You can run that macro alone.

That macro would as I wrote 'safe copy' from original P-column
and
after that
It will solve 'Your formula' to P-column as You can see.
Please, check that macro and You'll notice ...
( and if needed You can compare updated values with original values).
You can manually CLEAR 'safe copy'-values.

That code have to run from correct sheet ( which has those values ).