VBA Select rows which contain a negative value in column F [SOLVED]

Lymm · Aug 7, 2013

Hi, I have worksheet that contains a mix of income and expenses. The expenses are negative amounts, income positve. I would like to select the rows which contain a negative $ value in column F and paste these into my expenses sheet using VBA. The sheet will already be sorted with all the negative values together. What would be the best way to select these rows using VBA? Thank you for any assistance with this, Cheers, Lymm

Smallman · Aug 7, 2013

Hi Lymm

This is one way to do it. I have only assumed you are moving the values but you can change to suit.

[pre]

Code:

Sub MoveNegs()
Range(&#34;F1&#34;, Range(&#34;F65536&#34;).End(xlUp)).AutoFilter 1, &#34;&#60;0&#34;
Range(&#34;F2&#34;, Range(&#34;F65536&#34;).End(xlUp)).Copy Sheet2.Range(&#34;A65536&#34;).End(xlUp)(2)
Range(&#34;F1&#34;).AutoFilter
End Sub

[/pre]

Take care

Smallman

Lymm · Aug 7, 2013

Thank you Smallman, I had forgotten about auto filter.(Cooking tea and writing code at same time) I am working on it and will get back when I have some code that works for my situation.

SirJB7 · Aug 7, 2013

Hi, Lymm!

If you want a formula only solution, try this using 2 helper columns (B:C):

-----

[pre]

Code:

Amount	Helper +	Helper -	Income	Expense
10	1		0		10	-15
20	2		0		20	-5
0	2		0		2
-15	2		1
2	3		1
-5	3		2

[/pre]
-----

B2: =CONTAR.SI(A$2:A2;">0") -----> in english: =COUNTIF(A$2:A2,">0")

C2: =CONTAR.SI(A$2:A2;"<0") -----> in english: =COUNTIF(A$2:A2,"<0")

D2: =SI.ERROR(INDICE($A:$A;COINCIDIR(FILA()-1;B:B;0));"") -----> in english: =IFERROR(INDEX($A:$A,MATCH(ROW()-1,B:B,0)),"")

Copy D2 across to E2, copy B2:E2 down as required.

Regards!

Lymm · Aug 8, 2013

Thank you Sir JB7 I will try this as well. I Havent mastered the vba yet

Smallman · Aug 8, 2013

Hi Lymm

Post a sample of your workbook and if you like I will incorporate the vb with your problem. I suspect you will want to drag the Expenses with some explanatory data and compile the information on a monthly basis? If that assumption is correct then making the necessary adjustments to the above is not that difficult once I see the file layout.

Take care

Smallman

Lymm · Aug 8, 2013

Hi Again, What I was doing was importing two csv files into excel. One contained a mixture of income and expenses and the other just expenses. One of the problems was they both had different layouts and I couldnt just add one lot of expenses onto the other as the amounts were in different columns. I have revised my import macros to exclude unwanted columns and now have slightly tidier data to work with. I have been recording some macros and have managed to get the data all in the same format. I will post my improved file tomorrow, getting past my bedtime here. Thanks again for the pointers.

Lymm · Aug 11, 2013

I have managed to get some code together to sort the combined income and but I cannot get itto name my added sheet "Expenses2" . Its a bit messy could could somebody possibly tell me where i have gone wrong in trying to name my added sheet. Thank you in advance, Lymm

Sub Macrosortxpenseincome()
'
' Macrosortxpenseincome Macro
' Macro recorded 8/08/2013 by USER
'
Dim basebook As Workbook
Dim mysheet As Worksheet
Dim cell As Range
Dim Worksheet As Sheets

Sheets("INCOMEXPENSES&#34

.Activate
Range("A2:E2&#34

.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
'.LineStyle = xlContinuous
.Weight = xlThin
'.ColorIndex = xlAutomatic
End With
Range("A2&#34

.Select
ActiveCell.FormulaR1C1 = "Payment"
Range("B2&#34

.Select
ActiveCell.FormulaR1C1 = "Name1"
Range("C2&#34

.Select
ActiveCell.FormulaR1C1 = "Name2"
Range("D2&#34

.Select
ActiveCell.FormulaR1C1 = "Amount"
Range("E2&#34

.Select
ActiveCell.FormulaR1C1 = "Date"
Range("A2:E100&#34

.Select
Selection.Sort Key1:=Range("D3&#34

, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2&#34

.Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="<=0", Operator:=xlAnd
Range("A3:E63&#34

.Select
Selection.Copy

'Add workbook with one sheet
Set basebook = Workbooks.Add(xlWBATWorksheet)
Set basebook = ActiveWorkbook

Sheets.Add
'mysheet.Name = "Expenses2"
'Sheets.Name = ("Expenses2&#34

Range("A3&#34

.Select
ActiveSheet.Paste
Range("G3&#34

.Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=RC[-2]"
Range("H3&#34

.Select
ActiveCell.FormulaR1C1 = "=RC[-6]"
Range("I3&#34

.Select
Selection.Style = "Currency"
With Selection.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveCell.FormulaR1C1 = "=RC[-5]"
Range("G3:I3&#34

.Select
Selection.AutoFill Destination:=Range("G3:I66&#34

, Type:=xlFillDefault
Range("G3:I66&#34

.Select
Range("G3:I66&#34

.Select
Selection.AutoFill Destination:=Range("G3:I67&#34

, Type:=xlFillDefault
Range("A3:I3&#34

.Select
Selection.Columns.AutoFit
Range("I3:I100&#34

.Select
For Each cell In Selection
If Application.IsNumber(cell) Then
cell.Value = cell.Value * -1
End If
Next cell

Sheets("INCOMEXPENSES&#34

.Activate
Range("A3&#34

.Select
Selection.AutoFilter
End Sub

Lymm · Aug 11, 2013

Talking to myself a bit here but never mind, I just realised I could have used "advanced filter, copy to new sheet", criteria <0. (I am using excel 2003)

Smallman · Aug 11, 2013

Lymm

You got some sterling advice and employed the services of the macro recorder. I feel used and superseded : )

OK I think what you have done is wonderful however it is a bit over the top to create fresh columns in your new workbook to recreate data you already have.

Also why are you formatting your source workbook. That is a bit over the top doing it in VB each time. Just do it once in the template and paste your fresh P&L data into the workbook where the labels are formatted.

Here is the code and I will upload a workbook to support it shortly.

[pre]

Code:

Sub FixCode()
Dim twb As Workbook
Dim rng As Range
Dim ar As Variant

Set twb = ThisWorkbook
Set rng = Range(&#34;A2:E2&#34;)
ar = Array(&#34;Payment&#34;, &#34;Name1&#34;, &#34;Name2&#34;, &#34;Amount&#34;, &#34;Date&#34;)
rng = ar

rng.Borders(xlEdgeRight).LineStyle = xlContinuous
rng.Borders(xlEdgeLeft).LineStyle = xlContinuous
rng.Borders(xlEdgeTop).LineStyle = xlContinuous
rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
rng.Borders(xlInsideVertical).LineStyle = xlContinuous
Range(&#34;A3&#34;, Range(&#34;E65536&#34;).End(xlUp)).Sort [D3], 1

Range(&#34;D2&#34;, Range(&#34;D65536&#34;).End(xlUp)).AutoFilter 1, &#34;&#60;0&#34;
Range(&#34;A2&#34;, Range(&#34;E65536&#34;).End(xlUp)).Copy
Workbooks.Add
[a2].PasteSpecial

[a1] = -1
[a1].Copy
Range(&#34;D3&#34;, Range(&#34;D65536&#34;).End(xlUp)).PasteSpecial , 4
Range(&#34;D3&#34;, Range(&#34;D65536&#34;).End(xlUp)).Style = &#34;Currency&#34;
Columns(&#34;A:E&#34;).AutoFit
twb.Sheets(&#34;INCOMEXPENSES&#34;).[d2].AutoFilter
End Sub

[/pre]

Here is the link to the wokbook and associated code as promised.

http://rapidshare.com/files/2804705150/aaSolution.xlsm

Take care

Smallman

Lymm · Aug 11, 2013

Thanks a million Smallman, it works great but is putting the data into a new workbook instead of a named worksheet. I will see if I can work it out, Cheers.

Smallman · Aug 11, 2013

Hi Lymm

I just followed the logic of your coding and reproduced it. So you want to push the data into a worksheet within the same workbook. That is not a problem. The following will post your data to a fresh worksheet within the same workbook.

[pre]

Code:

Option Explicit

Sub FixCode()
Dim rng As Range
Dim ar As Variant

Set rng = Range(&#34;A2:E2&#34;)
ar = Array(&#34;Payment&#34;, &#34;Name1&#34;, &#34;Name2&#34;, &#34;Amount&#34;, &#34;Date&#34;)
rng = ar

rng.Borders(xlEdgeRight).LineStyle = xlContinuous
rng.Borders(xlEdgeLeft).LineStyle = xlContinuous
rng.Borders(xlEdgeTop).LineStyle = xlContinuous
rng.Borders(xlEdgeBottom).LineStyle = xlContinuous
rng.Borders(xlInsideVertical).LineStyle = xlContinuous
Range(&#34;A3&#34;, Range(&#34;E65536&#34;).End(xlUp)).Sort [D3], 2

Range(&#34;D2&#34;, Range(&#34;D65536&#34;).End(xlUp)).AutoFilter 1, &#34;&#60;0&#34;
Range(&#34;A2&#34;, Range(&#34;E65536&#34;).End(xlUp)).Copy
Sheets.Add
[a2].PasteSpecial

[a1] = -1
[a1].Copy
Range(&#34;D3&#34;, Range(&#34;D65536&#34;).End(xlUp)).PasteSpecial , 4
Range(&#34;D3&#34;, Range(&#34;D65536&#34;).End(xlUp)).Style = &#34;Currency&#34;
Columns(&#34;A:E&#34;).AutoFit
Sheets(&#34;INCOMEXPENSES&#34;).[d2].AutoFilter
End Sub

[/pre]

Take care

Smallman

Lymm · Aug 12, 2013

Thank you very much for your help, sorry about the workbook confusion. It is working great and has made things much easier for me. cheers, Lymm

Smallman · Aug 12, 2013

No worries Lymm

See you next time.

Smallman

VBA Select rows which contain a negative value in column F [SOLVED]

Lymm

Member

Smallman

Excel Ninja

Lymm

Member

SirJB7

Excel Rōnin

Lymm

Member

Smallman

Excel Ninja

Lymm

Member

Lymm

Member

Lymm

Member

Smallman

Excel Ninja

Lymm

Member

Smallman

Excel Ninja

Lymm

Member

Smallman

Excel Ninja