Here is my problem, I have those data on my Sheet1
A B C
1 Name Account Amount
2 John HSBC -20000
3 Ashley JPM 140000
4 Rose BAML 70000
5 John DB 10000
6 Rose Barclays -25000
7 Ashley JPM -3000
My goal is to use vba in order to sort lines and group them by name and amount. The result that I'm looking for in Sheet2 is :
A B C
1 Name Account Amount
2 John HSBC -20000
3 John DB 10000
4
5 Ashley JPM -3000
6 Ashley JPM 140000
7
8 Rose Barclays -25000
9 Rose BAML 70000
I already succeeded in taking the negative values first, but I still have difficulties in taking the rest and leave a blank line between groups.
Here is the code that I started :
Option Explicit
Sub sort_account()
Dim list_amount As Range, amount As Range
Dim b As Integer
Worksheets("Sheet1").Activate
Set list_amount = Worksheets("Sheet1").Range("C2", Range("C2").End(xlDown))
For Each amount In list_amount
If amount.Value < 0 Then
b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Sheet2").Cells(b + 1, 1).Value = amount.Offset(0, -2)
Worksheets("Sheet2").Cells(b + 1, 2).Value = amount.Offset(0, -1)
Worksheets("Sheet2").Cells(b + 1, 3).Value = amount
End If
Next amount
Worksheets("Sheet2").Activate
End Sub
And this gives me as a result :
A B C
1 Name Account Amount
2 John HSBC -20000
5 Ashley JPM -3000
8 Rose Barclays -25000
I really have difficulties for the rest. Do you have any ideas ? I thank you in advance for that.
Nb : The order doesn't matter, I just want that the first values of each group is the negative amount.
Thanks!
If this were my project, I would do it in three distinct steps: Copy all the data from sheet 1 to sheet 2; Sort the data in the preferred order; Insert the blank rows, starting from the bottom.
The following code should do what you’re after.
Option Explicit
Sub sort_account()
Dim LastRow As Long, i As Long
Sheet2.Cells.ClearContents
Sheet1.UsedRange.Copy Sheet2.Range("A1")
Sheet2.Columns("A:C").Sort Key1:=Sheet2.Range("A2"), order1:=xlAscending, _
Key2:=Sheet2.Range("C2"), order2:=xlAscending, Header:=xlYes
LastRow = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 4 Step -1
If Sheet2.Cells(i, "A") = Sheet2.Cells(i - 1, 1) Then
Sheet2.Cells(i - 1, "A").EntireRow.Insert
End If
Next i
End Sub
If your version of Excel supports Dynamic Arrays then you can do the following
This solution adds an extra row for each unique name, sorts the new data, and then blanks out the added rows.
E2 is =CHOOSE({1,2,3},UNIQUE(A2:A7),"temp",99999999). This creates an array with all the unique names in the first column, "temp" in the second column and 99999999 in the third (to be used for sorting).
F6 is =ROWS(A2:C7) the count of the rows in the data
F7 is =ROWS(E2#) the count of unique names
A10 is =IF(SEQUENCE(F6+F7)<=F6,A2:C7,INDEX(E2#,SEQUENCE(F6+F7)-F6,SEQUENCE(1,3))). This appends the original data to the new data.
E10 is =SORT(A10#,{1,3}), the appended data sorted.
I10 is =IF(F10:F18="temp","",E10#). This blanks out all the temps rows.
If your version of Excel supports LET you can do this in one cell.
=LET(data,A2:C7,
tempRows,CHOOSE({1,2,3},UNIQUE(A2:A7),"temp",99999999),
totalRows,ROWS(data),
uniqueNames,ROWS(tempRows),
outRows, SEQUENCE(totalRows+uniqueNames),
unsorted,IF(outRows<=totalRows,data,INDEX(tempRows,outRows-totalRows,{1,2,3})),
sorted,SORT(unsorted,{1,3}),
result, IF(INDEX(sorted,outRows,2)="temp","",INDEX(sorted,outRows,{1,2,3})),
result)
Related
I have a list of payees, their bank number, my reference and their reference, in a column.
R & J Fred Ltd
12-3456-7890123-45
Freds Fish
Bevan
Joe King Mata Ltd
01-1234-1234567-89
Joes Boats
Bevan01
Dave's the Barber
12-3456-7891478-92
Daves Shaves
Accnt 45
and I want to make it into a table like this:
Payee Account MyRef TheirRef
R & J Fred Ltd 12-3456-7890123-45 Freds Fish Bevan
Joe King Mata Ltd 01-1234-1234567-89 Joes Boats Bevan01
Dave's the Barber 12-3456-7891478-92 Daves Shaves Accnt 45
OK, so I have no idea how to get that into nice markdown for this site either, BTW :)
There's 300 rows of data, all in one column, following the same sequence all the way down the list.
I presume there's a simple way to do this but I can't seem to find it.
This is probably not the quickest or most elegant solution, but does get the desired result. This is based on the assumption that you data column is A, and the clean data will be in column B to E.
Sub Cleanmeup()
Dim lastrow As Integer
Dim cel As Range
Dim i As Double, j As Double
lastrow = Sheets(1).Range("A:A").Cells(Rows.Count, 1).End(xlUp).Row
i = 2
j = 2
For Each cel In Range("A2:A" & lastrow)
If i = 6 Then
i = 2
j = j + 1
End If
Cells(j, i).Value = cel
i = i + 1
Next cel
End Sub
I am trying to match up data in three adjacent columns with data in a fourth column.
This is how my data is currently organized:
ROW A B C
----------------------
1 Cat Car Red
2 Dog Bike Blue
3 Bird Car
4 Bear Car Blue
5 Fish Bike Red
6 Cow Car Red
(the values in column A are unique; the values in B and C are repeated values)
And this is how I need it to be organized:
ROW A B C
----------------------
1 Cat Car Red
2 Dog Bike Blue
3
4 Bird Car Blue
5 Bear Car Red
6 Fish Bike Red
Basically, I need columns A and B to see that column C is empty in row 3, and to insert blank cells in A3 and B3 so that each A and B value below that is moved down by one.
The spreadsheet has many of these needed insertions. Some of them will be individual insertions like the example above, but others might be 3, 4, 5, 10 insertions in a row.
Is there a formula or some kind of automated process I can use to make this happen?
Thanks!
From the example you posted, you want to push A and B down when C is blank?
Sub PushDown()
Dim X As Long
For X = 1 To Range("A" & Rows.Count).End(xlUp).Row
If IsEmpty(Range("C" & X)) Then Range("A" & X & ":B" & X).Insert xlDown
Next
End Sub
Sub clearContent()
Dim lastrow As Integer
lastrow = Range("D65536").End(xlUp).Row
For i = 2 To lastrow
If Cells(i, 4) = "" Then
Range(Cells(i, 2), Cells(i, 3)).ClearContents
End If
Next i
End Sub
Being beginner and first time on this site, I truly appreciate your help.
WK 1 WK 2 WK 3 WK 4 WK 5 TOTAL HOURS TOTAL OF FIRST 3 WEEKS <> 0
John 10 0 5 6 5 26 21
Smith 4 1 10 3 4 22 15
Peter 0 4 4 4 2 14 12
Susan 5 5 0 5 8 23 15
From my table I want to add only the first three columns that contain no zero. If there's zero on first three, check on next column and add it up to complete three columns again with no zero value. Some function like in Col H TOTAL OF FIRST 3 WEEKS <>0 (where I had to do it manually).
If I can learn set of VB code or any example with formula or macros, thank you so so much. I'm using Excel 2007.
This is the complicated formula Ali M refers to. It's an array formula entered with ctrl-shift-enter:
=IF(COUNTIF(A2:F2,"<>0")=0,0,SUM(A2:INDEX(A2:F2,SMALL(IF(A2:F2<>0,COLUMN(A2:F2),""),MIN(3,COUNTIF(A2:F2,"<>0"))))))
Note that it works if there are less than three non-zero values.
you can use formula but it would be complicated. instead you can use this subroutine that act exactly as you want!
Public Sub y()
Dim i, sum, c As Integer
Dim Rng, Row, cell As Range
Set Rng = Range("B2:F5")
i = 0
For Each Row In Rng.Rows
For Each cell In Row.Cells
If (cell.Value <> 0 And i < 3) Then
sum = sum + cell.Value
i = i + 1
End If
Next cell
Cells(Row.Row, 7).Value = sum
sum = 0
i = 0
Next Row
End Sub
It always put the sum in column H. you can change it by changing this line:
Cells(Row.Row, 7).Value = sum
Count unique values of a column where 2 other columns meet certain criteria. Assume column A is a list of Claim Numbers that repeat because each claim has multiple bills in multiple months (month is column B and location is column C), each row represents a bill. I need to be able to count the unique claim numbers with the criteria of month=3 and location="Chicago"
-Claim # Month Location
-1234 3 Chicago
-1234 3 Chicago
-1234 3 Chicago
-1234 3 Chicago
-3215 3 Chicago
-3215 3 Chicago
-3215 3 Chicago
-1334 4 Chicago
-1334 5 Chicago
-1235 3 Philadelphia
The answer here should be 2
Give this small macro a try:
Sub dural()
Dim c As Collection
Set c = New Collection
Dim N As Long, i As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To N
If Cells(i, 2).Value = 3 And Cells(i, 3).Value = "Chicago" Then
On Error Resume Next
c.Add Cells(i, 1), CStr(Cells(i, 1))
End If
Next
MsgBox c.Count
End Sub
I have a list of products listed on one worksheet, but not every product will have a value. In a separate worksheet I want it to only pull over the products that have values. I have been able to output the fist column of pizza but pizza-crust will not continue
Sheet 1 called prices
list pizza pizza-crust pizza-thin
pepper 1 5 8
beef 2
bacon 3 6
pineapple 4 9
mushroom 7 10
The macro that I have does the following
list pizza
pepper 1
beef 2
bacon 3
pineapple 4
how can i get it to fill in the data for the rest of the columns so that it would put pizza crust and then the data for each and then put pizza-thin and the data for that
below is the macro
Sub Button2_Click()
Dim column As Integer
column = 1
newrow = 1
Do Until Worksheets("sheet1").Cells(column, 1).Value = ""
If Worksheets("sheet1").Cells(column, 2).Value <> "" Then
Worksheets("sheet2").Cells(newrow, 1).Value = Worksheets("sheet1").Cells(column, 1).Value
Worksheets("sheet2").Cells(newrow, 2).Value = Worksheets("sheet1").Cells(column, 2).Value
newrow = newrow + 1
End If
column = column + 1
Loop
End Sub
thanks
Select cell B2 and run my unpivot add-in (available here). It should be easy after that to add the additional zero columns.