IF condition copy paste Range(ActiveCell.Offset(,) in new sheet

[incobart]

need a bit help to get the following :

I have a sheet whitch contain 50 small tables under eachother each 10 rows with header. with productname.
the 10 givings in each table are regulary updated from the internet with a time running macro.

now i want that when the 10 th row saying sold more the 5 pieces, he copy that table and put it in a new sheet
I think I can not use autofilter otherwise I loose the rest of the table,
so if cell 10 (20, 30, 40 ..) is >5 then
Range(ActiveCell.Offset(0, -6), ActiveCell.Offset(-10, -2)).Select
Selection.Copy
Sheets("StockAlert").Select and paste it there everytime above the last paste.
if he update , maybe 4 reach the condition, so he need a do loop ?
Thanks
Chris

[kev_]

It would be easier for anyone trying to help if you posted your workbook

To attach a file - click REPLY ... GO ADVANCED ... look below for MANAGE ATTACHMENTS etc

ManageAttachments3.jpg

[incobart]

Hi,

as it is not possible to update the original, and would make it more complex, I made a simple example of my wb to make it easy and clear
Thank you for your help !

Chris

[kev_]

Thanks for the workbook.

each table are regulary updated from the internet with a time running macro.

1. Please paste the time running macro into your reply (enclosed in code tags) by:
- clicking on # icon
- then:
[CODE ] paste your code here [/CODE ]

2. Is the macro in a sheet module or a general module?

3. Also please go to post#01
- click Edit Post
- select your code text
- click on the # icon

thanks

[incobart]

Im sorry, I made a mistake its not a macro its an query connection to the web, that reload every 10 min

[kev_]

no worries

Let's test each stage and then put it all together at the end:

TEST1: Does VBA to correctly identify what to copy?

VBA below:
- loops thru' all tables in sheet "Processing"
- returns 2 message boxes List of tables to NOT copy, list of tables to copy)
- message boxes list table name, table range, cell to be "conditionally" tested, value of that cell

Please run the VBA and let me know if the results are what you expect - if results are not correct please explain what is wrong
thanks

Place in a GENERAL module

Sub TableProperties()
    Dim t As ListObject
    Dim tCell As Range, tCellAddr As String, tAddr As String
    For Each t In Sheets("Processing").ListObjects

        Set tCell = t.DataBodyRange(t.ListRows.Count, 1)
        tAddr = t.Range.Address(0, 0)
        tCellAddr = tCell.Address(0, 0)
        
        If tCell.Value < -0.1 Or tCell.Value > 0.1 Then
            msg1 = msg1 & vbCr & t.Name & "  Range: " & tAddr & " ( " & tCellAddr & " = " & tCell.Value & " )"
        Else
            msg2 = msg2 & vbCr & t.Name & "  " & "  Range: " & tAddr & " ( " & tCellAddr & " = " & tCell.Value & " )"
        End If
    
    Next t
        MsgBox "Do NOT copy" & vbCr & vbCr & msg2
        MsgBox "Copy:" & vbCr & vbCr & msg1
End Sub

[incobart]

Thanks for your help, but its not really what I ask,
messages boxes interrupt the process..

and I want he know himself to copy or not,

so macro look per table, if the table meets the condition, range the table and copy it into stockview sheets if not , macro check next table ..

when I have a moment free I check stockview sheets and see what I must do

[kev_]

I know you do not want message boxes

The message boxes are to help me test the VBA - I do not have the "live" file
The message boxes will not be in the final code

Did the message boxes correctly identify which tables should be copied?

[kev_]

This code:
- loops thru' each table on sheet "Processing"
- tests value of bottom left cell is < -.1 or >.1
- inserts rows in sheet "STOCKVIEW"
- then copies tables passing test to sheet "STOCKVIEW"

Let me know if this is giving you what you want and then we can make it run every 10 minutes

Sub CopyTables()
    Dim ws As Worksheet, stockview As Worksheet
    Dim t As ListObject
    Dim tCell As Range, tCellAddr As String, tAddr As String
    Dim tCount As Integer, tRows As Integer
    
    Set ws = Sheets("Processing")
    Set stockview = Sheets("STOCKVIEW")
    tCount = ws.ListObjects.Count
    
    For i = tCount To 1 Step -1
        Set t = ws.ListObjects(i)
        Set tCell = t.DataBodyRange(t.ListRows.Count, 1)
        tAddr = t.Range.Address(0, 0)
        tRows = t.Range.Rows.Count
        tCellAddr = tCell.Address(0, 0)
        
        If tCell.Value < -0.1 Or tCell.Value > 0.1 Then
           ' copy this table
            stockview.Rows("1:" & tRows).Insert Shift:=xlDown
            t.Range.Copy stockview.Range("A1")
        Else
            'do not copy this table
        End If
    Next i
End Sub

[incobart]

haha I run it in the testfile,
so now i did it in the original
but I get the following, see screenshots :

[incobart]

at that moment SHOULD be copied ( i can be 1 figure lower or higher cause moved already)
D199 D276 D419 A966&d966 A980&D980 D1178

[incobart]

ok, I runned the second code
and it stops on stockview.Rows("1:" & tRows).Insert Shift:=xlDown
I changed already to capitals, but stay blocked, in the sheet stock view I see like an selected area same size as a table

[kev_]

and it stops on stockview.Rows("1:" & tRows).Insert Shift:=xlDown

if table contains 10 rows + heading
then this:

stockview.Rows("1:" & tRows).Insert Shift:=xlDown

is same as:

stockview.Rows("1:11").Insert Shift:=xlDown

I am not sure I understand what you are telling me
- is VBA is inserting the 10 rows and then not pasting anything?

instead of:

t.Range.Copy stockview.Range("A1")

try:

t.Range.Copy Destination:=stockview.Range("A1")

[incobart]

ok, I changed the 2 lines and it didnt stops, but there was nothing in the stockview
althoug there where a few D cell conditions reached but no A cells
so I runned it on a second sheet where there were A cells reached condition.
It stoppes again at the same lines , so I changedthem back to the old ones, and yes he go true.

There was 1 table a good one in the stockview :-) there were 4 tables with A conditions reached, he paste only the last one

Thanks

[kev_]

The VBA works for me, but there must be something different in your worksheet

I gave you the code with the message boxes in post#06 to help you to tell me what the code is doing wrong
I have amended that code below so that it does not include the long table name.

Before running the code, make a note of the tables that "pass" the condition.
You will need to check what the message box gives for:
- table range
- cell address (bottom left cell)
- cell value

Is the error in the table range?
Is the error in the cell address?
Is the error in the condition?

thanks

Sub TableProperties()
    Dim t As ListObject
    Dim tCell As Range, tCellAddr As String, tAddr As String
    For Each t In Sheets("Processing").ListObjects

        Set tCell = t.DataBodyRange(t.ListRows.Count, 1)
        tAddr = t.Range.Address(0, 0)
        tCellAddr = tCell.Address(0, 0)
        
        If tCell.Value < -0.1 Or tCell.Value > 0.1 Then
            msg1 = Range: " & tAddr & " ( " & tCellAddr & " = " & tCell.Value & " )"
        Else
            msg2 = Range: " & tAddr & " ( " & tCellAddr & " = " & tCell.Value & " )"
        End If
    
    Next t
        MsgBox "Do NOT copy" & vbCr & vbCr & msg2
        MsgBox "Copy:" & vbCr & vbCr & msg1
End Sub

[incobart]

something wrong ..?

[incobart]

update, the automatic refresh happens and i tried again, and he bring tables on the copy msg window
I checked them and all the selected windows were correct for A cells, D cells not checked ??

[incobart]

Meanwhile I tried the old script end took t.name out

i got screen with ranges not to copy .. (in fact every table range) text stops at 111... (maybe to much for the msg window)
the copy windows results empty, I tried on the 3 table sheets, and all same ..

[incobart]

update, this morning I did some tests, (i have 3 table sheets) it select the correct tables based on condition A
the 3 th table sheets blocks on If tCell.Value < -0.1 Or tCell.Value > 0.1 Then but I think the reason is that there are some #N/A in the checklist
Your macro also put the tablein stockview and move the old one down perfect
at the moment I dont have more than 1 table to select, I am waiting till more come to test if he copy paste them all
For the rest I try tofigure out your script, but look like magic to me how you manage it, i dont see A D tablesize ...waaw

[incobart]

as I send the message, i get signal , and see 2 conditions reached. the macro copy paste both in stockvies but also 1 table below the last one that doesnt have the condition
so I got 3 tables, while only first2 needed

[incobart]

last update : did some more tests, the script works excelent,
it takes out the correct taA tables, and I figured out already that changing Set tCell = t.DataBodyRange(t.ListRows.Count, 4) he do the D cells, also perfect
no extra table comming.

so only 2 things left, what about block when #N/A value, end how can let it run automatic for a and d.
now i have a macro running every 10 min to copy the latest result to a table that holds the result from 10 min back and this 10 times (so untill 100 min back)
Therefor i use : Application.OnTime Now + TimeValue("00:10:00"), "UPDATE"

[kev_]

block when #N/A value

Wrap another condition around the other condition like this:

        
     If IsNumeric(tCell.Value) Then
        If tCell.Value < -0.1 Or tCell.Value > 0.1 Then
           ' copy this table
            stockview.Rows("1:" & tRows).Insert Shift:=xlDown
            t.Range.Copy stockview.Range("A1")
        Else
            'do not copy this table
        End If
     End If

[kev_]

One way to automate everything:

1 Cancel the direct update and you run it from macro instead
(see Sub RefreshAllTables below)
2 Add a timer
(Sub StartTimer)
3 Provide a method to stop the timer
(Sub StopTimer)
4 Start the timer when the file is opened
(Private Sub Workbook_Open)
5 Stop the timer when the file is closed
(Private Sub Workbook_BeforeClose)
6 Call the relevant subs
(sub RefreshAndCopy)

THIS ALL IN THE SAME General MODULE:

'declaring public variables - must be done at the TOP of the module to make these variables available to all procedures
Public RunWhen As Double
Public Const RunThis = "RefreshAndCopy"

Sub StartTimer()
RunWhen = Now + TimeSerial(0, 10, 0)
Application.OnTime earliesttime:=RunWhen, procedure:=RunThis, schedule:=True
End Sub

Sub StopTimer()
   On Error Resume Next
   Application.OnTime earliesttime:=RunWhen, procedure:=RunThis, schedule:=False
End Sub

Sub RefreshAndCopy()
    Call RefreshAllTables
    Call CopyTables
    Call StartTimer
End Sub

Sub CopyTables()
    'your latest code here
End Sub

Sub RefreshAllTables()
    
    Dim ws As Worksheet, QT As QueryTable, t As ListObject
    
    Set ws = Sheets("Processing")

        For Each t In ws.ListObjects
            If t.SourceType = 3 Then
                With t.QueryTable
                    .BackgroundQuery = False
                    .Refresh
                End With
            End If
        Next t

        For Each QT In ws.QueryTables
            QT.Refresh BackgroundQuery:=False
        Next QT
    Set QT = Nothing

End Sub

THIS IN THE ThisWorkbook MODULE:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopTimer
End Sub

Private Sub Workbook_Open()
    Call StartTimer
End Sub

[incobart]

hey Kev

so many Thanks ! you are great, I am setting it all up now .. how to adjust the original script so that he also checks for the D cells ? or dp I have to run it twice ?

greets
Chris

[kev_]

(condition2 = condition for D cells)

Q1. a) or b)?
a) IF condition1 AND condition2 satisfied then copy table
b) IF condition1 OR condition 2 satisfied then copy table

Q2. what is the condition for the D cells?

[incobart]

Can do like this ?
condition 1 OR condition 2
condition 2 = If( tCell.Value < -0.1 AND A-cell <-0.01) Or (tCell.Value > 0.1 AND A-cell >0.01)

or too complex ?

[kev_]

Here is simple method to follow:
- add a Boolean variable (= True or False variable)
- create 2 separate conditions like this (using your notation) :

    Dim copyTable As Boolean    'place with other declared variables
    copyTable = False
    If tCell.Value < -0.1 And a-cell < -0.01 Then copyTable = True
    If tCell.Value > 0.1 And a-cell > 0.01 Then copyTable = True
    If copyTable = True Then
     ' copy this table
            stockview.Rows("1:" & tRows).Insert Shift:=xlDown
            t.Range.Copy stockview.Range("A1")
    Else
            'do not copy this table
    End If

To avoid having 2 variables - this code should work if tCell is in columnD and a-cell is in columnA, of SAME row)

    Dim copyTable As Boolean    'place with other declared variables
    copyTable = False
    If tCell.Value < -0.1 And tCell.Offset(0, -3).Value < -0.01 Then copyTable = True
    If tCell.Value > 0.1 And tCell.Offset(0, -3).Value > 0.01 Then copyTable = True
    If copyTable = True Then
     ' copy this table
            stockview.Rows("1:" & tRows).Insert Shift:=xlDown
            t.Range.Copy stockview.Range("A1")
    Else
            'do not copy this table
    End If

[incobart]

Hi Kev,

I feel shy to bother you again, .. but it doesn't work wellhe stay long time on calculating
he don't get the right tables also.
I will tell you what I did :
I wanted to improve my filter more (sorry)
( yes A cell and D cellare in the same row, a12and D12 last row of the table)
1. select every table where a cell is > then 10 % or lower then -10 %
2. check if de last 3 values in D are going up, (cause sometimes go up +10 % and stay on +10%, but he keep sending, while it not change anymore)
3. to see that the going up from the last 3 cells is sufficiant , it must be also difference of 10 % (like second condition before)
I made the 3 rules and they all work perfect SEPERATLY

IF (tCell.Value > 0.1 Then
.....
If (tCell.Value > tCell.Offset(-1, 0).Value And tCell.Offset(-1, 0).Value > tCell.Offset(-2, 0).Value And tCell.Offset(-2, 0).Value > tCell.Offset(-3, 0).Value) Then
....
If (tCell.Offset(0, -2).Value/tCell.Offset(-3, -2).Value)>1.1)) Then

I put each between () and Or .... And between but he don't bring the second condition
first 2 together , no, last 2 , no...
so I did then with your copytable boolean, but then he brought a lot of tables, and not correct at all
even only the first condition, wrong tables comming ..
so a bit end of ideas now..
how can I make it work these 3 conditions for going up and going down

[kev_]

Sorry, I do not understand those conditions
It will be much easier if you provide examples

Please attach a workbook with 20 tables
- 15 that should be copied
- 5 that should not be copied

Try to cover all the conditions for "copy" and "do not copy"

Please explain next to each table why it should\should not be copied

thank you

[incobart]

ok, sorry I did my best to example it in the workbook

[kev_]

Thanks, will look at your file tomorrow and post reply by 10am (UK)

[kev_]

delayed this morning, will post later...

[kev_]

Try this
- variable names amended to aCell (columnA) and Dcell (columnD) to make it easier to follow
- 5 variables added D1,D2,D3,D4 and D5
- conditions where table copied are now simplified into 4 separate conditions

Run in attached workbook with {CTRL} t

Sub CopyTables()
    Dim ws As Worksheet, stockview As Worksheet
    Dim t As ListObject, copyTable As Boolean
    Dim aCell As Range, dCell As Range, aCellAddr As String, tAddr As String
    Dim tCount As Integer, tRows As Integer
    Dim D1 As Double, D2 As Double, D3 As Double, D4 As Double, D5 As Double
    
    Set ws = Sheets("Processing")
    Set stockview = Sheets("STOCKVIEW")
    tCount = ws.ListObjects.Count
    
    For i = tCount To 1 Step -1
        Set t = ws.ListObjects(i)
        Set aCell = t.DataBodyRange(t.ListRows.Count, 1)
        tAddr = t.Range.Address(0, 0)
        tRows = t.Range.Rows.Count
        aCellAddr = aCell.Address(0, 0)
    'values in column D
        Set dCell = aCell.Offset(, 3)
        D1 = dCell.Value
        D2 = dCell.Offset(-1).Value
        D3 = dCell.Offset(-2).Value
        D4 = dCell.Offset(-3).Value
        D5 = Abs(D1 - D4)
        
    'conditions to satisfy
        copyTable = False
        If aCell.Value < -0.1 Then copyTable = True
        If aCell.Value > 0.1 Then copyTable = True
        If D1 > D2 And D2 > D3 And D3 > D4 And D5 > 0.1 Then copyTable = True
        If D1 < D2 And D2 < D3 And D3 < D4 And D5 > 0.1 Then copyTable = True
    
    'copy table
        If copyTable = True Then
            stockview.Rows("1:" & tRows).Insert Shift:=xlDown
            t.Range.Copy stockview.Range("A1")
        Else
            'do not copy this table
        End If
    Next i
End Sub

[incobart]

Hi Kev, looks great ! Thanks ! ..
1 problem on sheet3 again, what about #N/A ...

[kev_]

How about same technique as before:

Sub CopyTables()
    Dim ws As Worksheet, stockview As Worksheet
    Dim t As ListObject, copyTable As Boolean
    Dim aCell As Range, dCell As Range, aCellAddr As String, tAddr As String
    Dim tCount As Integer, tRows As Integer
    Dim D1 As Double, D2 As Double, D3 As Double, D4 As Double, D5 As Double
    
    Set ws = Sheets("Processing")
    Set stockview = Sheets("STOCKVIEW")
    tCount = ws.ListObjects.Count
    
    For i = tCount To 1 Step -1
        Set t = ws.ListObjects(i)
        Set aCell = t.DataBodyRange(t.ListRows.Count, 1)
        tAddr = t.Range.Address(0, 0)
        tRows = t.Range.Rows.Count
        aCellAddr = aCell.Address(0, 0)
    'values in column D
        Set dCell = aCell.Offset(, 3)
        D1 = dCell.Value
        D2 = dCell.Offset(-1).Value
        D3 = dCell.Offset(-2).Value
        D4 = dCell.Offset(-3).Value
        D5 = Abs(D1 - D4)
        
    'conditions to satisfy
        copyTable = False
        If IsNumeric(aCell.Value) Then
            If aCell.Value < -0.1 Then copyTable = True
            If aCell.Value > 0.1 Then copyTable = True
        End If
        If IsNumeric(D1) And IsNumeric(D2) And IsNumeric(D3) And IsNumeric(D4) Then
            If D1 > D2 And D2 > D3 And D3 > D4 And D5 > 0.1 Then copyTable = True
            If D1 < D2 And D2 < D3 And D3 < D4 And D5 > 0.1 Then copyTable = True
        End If
        
    'copy table
        If copyTable = True Then
            stockview.Rows("1:" & tRows).Insert Shift:=xlDown
            t.Range.Copy stockview.Range("A1")
        Else
            'do not copy this table
        End If
    Next i
End Sub

[incobart]

on Sheet 1 and 2 it works perfect on sheet 3 it blocks at D1 = dCell.Value
although he select already some tables
I thought it was of #N/A values so thats why I asked,
In the new script it still blocks on D1 = dCell.Value

[kev_]

deleted by kev_

[kev_]

It is probably because D1 etc are not decimal values

so replace:

Dim D1 As Double, D2 As Double, D3 As Double, D4 As Double, D5 As Double

with:

Dim D1, D2, D3, D4, D5

This will allow the code to run, and then if values are not valid IsNumeric takes care of them

[incobart]

ok, it move on, but now ask debug on D5 = Abs(D1 - D4)

[kev_]

See RED for solution to your question (again same technique)

But have you thought about removing all #N/A values from data tables and clearing those cell values?
see code in this colour
If you remove all #N/A values then IsNumeric tests would not be required

Sub CopyTables()
    Dim ws As Worksheet, stockview As Worksheet
    Dim t As ListObject, copyTable As Boolean
    Dim aCell As Range, dCell As Range, aCellAddr As String, tAddr As String
    Dim tCount As Integer, tRows As Integer
    Dim D1, D2, D3, D4, D5
    Dim rng As Range, cel As Range
    
    Set ws = Sheets("Processing")
    Set stockview = Sheets("STOCKVIEW")
    tCount = ws.ListObjects.Count
    
    Set rng = ws.Range("A1", ws.Range("D" & Cells.Rows.Count).End(xlUp))
    For Each cel In rng
        If Application.WorksheetFunction.IsNA(cel.Value) Then
            cel.ClearContents
        End If
    Next cel
    
    For i = tCount To 1 Step -1
        Set t = ws.ListObjects(i)
        Set aCell = t.DataBodyRange(t.ListRows.Count, 1)
        tAddr = t.Range.Address(0, 0)
        tRows = t.Range.Rows.Count
        aCellAddr = aCell.Address(0, 0)
    'values in column D
        Set dCell = aCell.Offset(, 3)
        D1 = dCell.Value
        D2 = dCell.Offset(-1).Value
        D3 = dCell.Offset(-2).Value
        D4 = dCell.Offset(-3).Value
        If IsNumeric(D1) And IsNumeric(D4) Then
            D5 = Abs(D1 - D4)
        End If
        
    'conditions to satisfy
        copyTable = False
        If IsNumeric(aCell.Value) Then
            If aCell.Value < -0.1 Then copyTable = True
            If aCell.Value > 0.1 Then copyTable = True
        End If
        If IsNumeric(D1) And IsNumeric(D2) And IsNumeric(D3) And IsNumeric(D4) Then
            If D1 > D2 And D2 > D3 And D3 > D4 And D5 > 0.1 Then copyTable = True
            If D1 < D2 And D2 < D3 And D3 < D4 And D5 > 0.1 Then copyTable = True
        End If
        
    'copy table
        If copyTable = True Then
            stockview.Rows("1:" & tRows).Insert Shift:=xlDown
            t.Range.Copy stockview.Range("A1")
        Else
            'do not copy this table
        End If
    Next i
End Sub

[incobart]

saw the message ?

[kev_]

which message?

[incobart]

Hi Kev,

Used some time this week to test and adjust the macro's, it all works fine, I want to give you my special thanks , for your great & kind help !

[kev_]

You are welcome 😀