copy data contains minus values for the last column

[abdo meghari]

Hello ,
I want creating report by copy data contains minus numbers for the last column , but the macro should deal with last column that add every time and deal with change data in first sheet .

before

Bridgestone Stock Sales report (2).xls
	A	B	C	D	E	F	G	H	I	J	K	L
1				DECEMBER			JANUARY			FEBRUARY
2	Size	Pattern	Origin	Arrived	Sales	Stock	Arrived	Sales	Stock	Arrived	Sales	Stock
3	BS 175/70R13	B25A32	INDO	-	-	-	-	-	-	-	-	-
4	BS 175/70R13	EP150	INDO	-	-	-	-	-	-	-	-	-
5	BS 175/70R13	EP150	THI	344	20	324	-	-	324	-	57	267
6	BS 175/70R13	EP150	TR	3	-	3	-	4	-1	-	-	-1
7	BS 185/70R13	EP150	INDO	34	20	14	4	1	17	-	-	17
8	BS 185/70R13	EP150	THI	-	8	-8	-	-	-8	-	-	-8
9	BS 175/65R14	EP150	THI	-	-	-	-	-	-	-	-	-
10	BS 175/65R14	EP150	JAP	-	-	-	-	-	-	-	-	-
11	BS 175/65R14	B25A32	INDO	-	-	-	-	-	-	-	-	-
12	BS 175/65R14	B25A32	THI	-	-	-	-	-	-	-	150	-150
13	BS 175/70R14	EP150	THI	-	20	-20	-	-	-20	-	-	-20
14	BS 175/70R14	MY02	THI	-	-	-	-	-	-	-	-	-
15	BS 185/65R14	TEC	THI	-	-	-	4	1	3	-	9	-6
16	BS 185/65R14	EP150	INDO	9	-	9	-	18	-9	-	-	-9
17	BS 185/65R14	EP150	TR	-	-	-	123		123	-	13	110
18	BS 185/65R14	150EZ	INDO	-	-	-	-	-	-	-	-	-
19	BS 185/70R14	B25A32	THI	-	-	-	-	-	-	-	-	-
20	BS 195/70R14	150EZ	THI	-	-	-	-	-	-	-	100	-100
In & Out Balance

Cell Formulas
Range	Formula
F3:F20	F3	=D3-E3
L3:L20,I3:I20	I3	=F3+G3-H3

result should be as this

Bridgestone Stock Sales report (2).xls
	A	B	C	D
1
2	Size	Pattern	Origin	Stock
3	BS 175/70R13	EP150	TR	-1
4	BS 185/70R13	EP150	THI	-8
5	BS 175/65R14	B25A32	THI	-150
6	BS 175/70R14	EP150	THI	-20
7	BS 185/65R14	TEC	THI	-6
8	BS 185/65R14	EP150	INDO	-9
9	BS 195/70R14	150EZ	THI	-100
RESULT

 

[kevin9999]

One option. Try on a copy of your data.

Option Explicit
Sub abdoM()
    Application.ScreenUpdating = False
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("In & Out Balance")
    Set ws2 = Worksheets("RESULT")
    Dim LRow As Long, LCol As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws1.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    
    'Clear RESULT sheet first
    If ws2.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row > 2 Then
        ws2.Range(ws2.Cells(3, 1), ws2.Cells(ws2.Cells.Find("*", , xlFormulas, , 1, 2).Row, 4)).ClearContents
    End If
    
    Dim rng As Range, r As Range
    Set rng = ws1.Range(ws1.Cells(2, 1), ws1.Cells(LRow, LCol))
    With rng
        .AutoFilter LCol, "<0"
        If ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row > 2 Then
            Set rng = .Offset(1).Resize(.Rows.Count - 1)
            With rng
                Set r = Union(.Columns("A:C"), .Columns(LCol))
                r.Copy
                ws2.Range("A3").PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
        End If
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[abdo meghari]

Thanks
what does mean this error?
"object variable or with block variable not set " in this line

 If ws2.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row > 2 Then

 

[kevin9999]

What does your RESULT sheet look like before you run the code? Do you have headers in row 2 as in your original post?

 

[abdo meghari]

good catching !
there is no any header , I expect the macro does that without writing manually , is it possible?

 

[kevin9999]

Yes, try this one instead:

Option Explicit
Sub abdoM_V2()
    Application.ScreenUpdating = False
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("In & Out Balance")
    Set ws2 = Worksheets("RESULT")
    Dim LRow As Long, LCol As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws1.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    
    'Clear RESULT sheet first
    ws2.Cells.ClearContents
    ws2.Range("A2").Resize(, 4).Value = Array("Size", "Pattern", "Origin", "Stock")
    
    Dim rng As Range, r As Range
    Set rng = ws1.Range(ws1.Cells(2, 1), ws1.Cells(LRow, LCol))
    With rng
        .AutoFilter LCol, "<0"
        If ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row > 2 Then
            Set rng = .Offset(1).Resize(.Rows.Count - 1)
            With rng
                Set r = Union(.Columns("A:C"), .Columns(LCol))
                r.Copy
                ws2.Range("A3").PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            End With
        End If
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[abdo meghari]

thanks but it copies without borders and formatting .

 

[kevin9999]

Try again

Option Explicit
Sub abdoM_V3()
    Application.ScreenUpdating = False
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("In & Out Balance")
    Set ws2 = Worksheets("RESULT")
    Dim LRow As Long, LCol As Long
    LRow = ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws1.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    
    'Clear RESULT sheet first
    ws2.Cells.ClearContents
    ws2.Range("A2").Resize(, 4).Value = Array("Size", "Pattern", "Origin", "Stock")
    
    Dim rng As Range, r As Range
    Set rng = ws1.Range(ws1.Cells(2, 1), ws1.Cells(LRow, LCol))
    With rng
        .AutoFilter LCol, "<0"
        If ws1.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row > 2 Then
            Set rng = .Offset(1).Resize(.Rows.Count - 1)
            With rng
                Set r = Union(.Columns("A:C"), .Columns(LCol))
                r.Copy
                With ws2.Range("A3")
                    .PasteSpecial xlPasteValues
                    .PasteSpecial xlPasteFormats
                End With
                Application.CutCopyMode = False
            End With
        End If
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[abdo meghari]

the same thing as in post#6

 

[kevin9999]

the same thing as in post#6

No it isn't, these lines have been added:

With ws2.Range("A3")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
End With

Did you run it again?
What format did it not copy?