Macro to keep on going to the next cell till the value doesn't match and for all the similar values, subtract the values from the bottom most row
Essentially my data is like this (There is only one buy for each name and it is the bottom most cell)
Name | Transaction.Type | Amount | Remaining (what macro needs to do)
Name1 | Sell | 5 | 15 (20-5)
Name1 | Sell | 10 | 10 (20-10)
Name1 | Sell | 15 | 5 (20-15)
Name1 | Buy | 20 |
Name2 | Sell | 25 | 5
Name2 | Buy | 30 |
So far my macro looks like
Dim sline As Integer
Dim eline As Integer
Dim rng As Range
Dim lastrow(1 To 3) As Long
Application.DisplayAlerts = False
With Worksheets("Testing Data 2")
lastrow(1) = .Cells(Rows.Count, "A").End(xlUp).Row
End With
For i = 2 To 4151
If Worksheets("Testing Data 2").Range("A" & i) <> Worksheets("Testing Data 2").Range("A" & i).Offset(1, 0) Then
eline = i
Worksheets("Testing Data 2").Range(":C" & eline)
'struggling to go from here
End If
Next i
Application.DisplayAlerts = True
You can do this without VBA with the understanding that each Name only has one instnace of Buy
=SUMIFS(C:C,A:A,A3,B:B,"Buy")-C2 'Drag down as needed
Related
I was wondering how to paste filtered data into the same corresponding rows but another column.
I have a filtered Table in Excel like this:
#Row | A | B
1 | foo |
5 | bar |
8 | fish |
Now I want to paste values from Column A into B maintaining the row position.
#Row | A | B
1 | foo | foo
2 | |
3 | |
4 | |
5 | bar | bar
... | |
... | |
8 | fish | fish
the normal paste method pastes the values as a consecutive block.
last = db_ws.Rows(Rows.Count).End(xlUp).Row
db_ws.Range("A11:BC" & last).SpecialCells(xlCellTypeVisible).Copy
tgt_ws.Range("A11").PasteSpecial
Any help appreciated.
Code snippet:
Dim i as Long
last = db_ws.Rows(Rows.Count).End(xlUp).Row
For i = 11 to last
If db_ws.Range("A"& i).EntireRowHidden=False Then
tgt_ws.Range("A"& i).Value = db_ws.Range("A" & i).Value
tgt_ws.Range("B" & i).Value = db_ws.Range("A" & i).Value
End If
Next i
For completion of the topic here you go with the array solution.
count = -1 ' array has to start with 0
On Error GoTo errHndlr:
For Each cl In rng.SpecialCells(xlCellTypeVisible)
count = count + 1
ReDim Preserve arr(count)
arr(count) = cl.Row
Debug.Print cl.Row
Next cl
errHndlr:
For Each Item In arr
db_ws.Cells(Int(Item), 55) = db_ws.Cells(Int(Item), 1).Value
Next Item
Probably this question is very rookie, but not really used to play a lot with Excel, anyway here I go.
I have 2 spreadsheets: A and B
In the spreadsheet "A" have the following info:
+----------+--------+-------+------+
| DATE | CODE | CORRL | CAPA |
+----------+--------+-------+------+
| 01/03/17 | 110104 | 5 | 28 |
| 01/03/17 | 110104 | 7 | 30 |
| 01/03/17 | 810107 | 5 | 30 |
+----------+--------+-------+------+
and in the spreadsheet "B" the following info:
+----------+--------+-------+--------+
| DATE | CODE | CORRL | SN |
+----------+--------+-------+--------+
| 01/03/17 | 110104 | 5 | 182694 |
| 01/03/17 | 110104 | 5 | 571394 |
| 01/03/17 | 110104 | 7 | 298435 |
| 01/03/17 | 110104 | 7 | 205785 |
| 01/03/17 | 810107 | 5 | 234519 |
| 01/03/17 | 810107 | 5 | 229787 |
+----------+--------+-------+--------+
So what I need is when I move through the records of the spreadsheet "A" only the records with the same value of DATE, CODE and CORRL in the spreadsheet "B" are shown
Example:
If I'm positioned in the 1st row of the spreadsheet "A" in the spreadsheet "B" only the first 2 records must be shown, that is:
+-----------+---------+--------+--------+
| DATE | CODE | CORRL | SN |
+-----------+---------+--------+--------+
| 01/03/17 | 110104 | 5 | 182694 |
| 01/03/17 | 110104 | 5 | 571394 |
+-----------+---------+--------+--------+
and so on
Thanks
I have to say, this is one of the more different requests that I've seen for Excel functionality.
I think I have something for you.
Firstly, if you're not familiar with the VBA editor then you can access it by pressing Alt + F11. Another way to access it is from the Developer tab in your ribbon, which is hidden by default. To unhide it, change the ribbon to include it.
From there you can get to the VBA editor as well as run macros.
From within there, add the following code ...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lngRow As Long, lngCol As Long, strDate As String, strCode As String, strCorrl As String
Dim strKey As String, strSlaveKey As String, i As Long
If objSlaveSheet Is Nothing Then Exit Sub
objSlaveSheet.Rows.EntireRow.Hidden = True
objSlaveSheet.Rows(1).Hidden = False
If Target.Cells(1, 1).Row > 1 Then
With Target.Worksheet
strDate = .Cells(Target.Row, 1)
strCode = .Cells(Target.Row, 2)
strCorrl = .Cells(Target.Row, 3)
strKey = strDate & "_" & strCode & "_" & strCorrl
End With
' Now loop through all of the cells in the slave workbook.
' Start at the second row because the first has a header.
With objSlaveSheet
For lngRow = 2 To .Rows.Count
strSlaveKey = ""
For i = 1 To 3
strSlaveKey = strSlaveKey & "_" & .Cells(lngRow, i)
Next
strSlaveKey = Mid(strSlaveKey, 2)
If strSlaveKey = "__" Then Exit For
If strSlaveKey = strKey Then
.Rows(lngRow).Hidden = False
End If
Next
.Activate
.Cells(1, 1).Select
End With
End If
End Sub
... into the worksheet where you want to trigger the selection from, this is your worksheet A.
Also in workbook A, create a new Module in the VBA editor and paste the following code ...
Public objSlave As Workbook
Public objSlaveSheet As Worksheet
Public Sub SelectSlaveBook()
Dim objDlg As FileDialog, strFile As String, strSlaveSheetName As String
strSlaveSheetName = "Sheet1"
Set objDlg = Application.FileDialog(msoFileDialogOpen)
objDlg.Show
If objDlg.SelectedItems.Count > 0 Then
strFile = objDlg.SelectedItems(1)
Set objSlave = Application.Workbooks.Open(strFile, False, True)
Set objSlaveSheet = objSlave.Worksheets(strSlaveSheetName)
ThisWorkbook.Activate
End If
End Sub
... before moving on, make sure you change the value of strSlaveSheetName to be the name of the sheet where your data is in your "Slave" workbook (B).
Finally in worksheet A, add the following code into the ThisWorkbook object ...
Private Sub Workbook_Open()
SelectSlaveBook
End Sub
... now close the master workbook (in your case, workbook A) and open it again.
You will be prompted for the location of the "Slave" workbook (workbook B).
Once you've given that location, select what you want to select and all things held constant, it should work for you.
Of course, if it needs tweaks to suit your exact requirement, that's always possible.
I hope it works for you.
I have the following data in an excel worksheet, in columns A, B and C respectively.
+-----------+--------------+----------------+
| RangeName | Clear? | Value if Clear |
+-----------+--------------+----------------+
| Name1 | DO NOT CLEAR | |
| Name2 | | 6 |
| Name3 | | 7 |
| Name4 | DO NOT CLEAR | |
| Name5 | DO NOT CLEAR | |
| Name6 | DO NOT CLEAR | |
| Name7 | DO NOT CLEAR | |
| Name8 | DO NOT CLEAR | |
| Name9 | | 5 |
| Name10 | | 9 |
+-----------+--------------+----------------+
Theres a "clear" macro which checks for each excel range name, if column B says "DO NOT CLEAR" then it will skip and do nothing, if it is blank then it will clear the range name and set the range name value to column C. The code is as follows:
For i = 1 To MaxRowCount
Select Case Range("RngeTbl").Cells(i, 2).Value
Case "DO NOT CLEAR" 'do nothing
Case Else 'set to default value
Range(Range("RngeTbl").Cells(i, 1).Value).Value = Range("RngeTbl").Cells(i, 3).Value
End Select
Next i
However, the number of range names is increasing massively, and right now I have 32571 range names.
Is there a way I can speed this macro up? I've been trying put the column into an array and somehow check that way but I'm having no luck.
Any help please!
The following code should be slightly better (if run in the context of Application.ScreenUpdating = Fasle, etc.):
Dim A As Variant
Set A = Range("RngeTbl").Value
For i = 1 To UBound(A)
If A(i,2) <> "DO NOT CLEAR" Then Range(A(i,1)).Value = A(i,3)
Next i
If MaxRowCount is smaller than the number of rows in the range, then of course you could use that rather than UBound(A) in the loop.
This code will Sort your RngeTbl range on the "Clear?" column, then count how many non-Blank cells are in the "Clear?" column, and start the loop at the next row.
This will mean that the loop skips all of the "DO NOT CLEAR" ranges - if all ranges are to be cleared then the code will run slightly slower. If there are no ranges to be cleared then the code will only take about as long as the Sort does.
Dim lStart As Long
'Sort the range, without header
[RngeTbl].Sort [RngeTbl].Cells(1, 2), xlAscending, Header:=xlNo
'Since Calculation should be Manual for speed, we recalculate the sorted Range...
[RngeTbl].Calculate
'Count the Non-Blank cells in the "Clear?" column, to find the first non-blank cell
lStart = 1 + WorksheetFunction.CountA([RngTbl].Columns(2))
'If there ARE any non-blank cells
If lStart <= MaxRowCount Then
'Skip all of the "DO NOT CLEAR" cells
For i = lStart To MaxRowCount
Range(Range("RngeTbl").Cells(i, 1).Value).Value = Range("RngeTbl").Cells(i, 3).Value
Next i
Next lStart
There are 2 worksheets in 1 excel file with the following identical column structure:
BuildIndex | Phase | Module | Duration
The column BuildIndex is used as primary key.
Assume the following example data:
Worksheet 1:
1 | Phase 1 | Module 1 | 5
1 | Phase 2 | Module 1 | 3
1 | Phase 3 | Module 1 | 10
1 | Phase 1 | Module 2 | 6
1 | Phase 2 | Module 2 | 2
1 | Phase 3 | Module 2 | 5
Worksheet 2:
2 | Phase 1 | Module 1 | 3
2 | Phase 2 | Module 1 | 7
2 | Phase 3 | Module 1 | 9
2 | Phase 1 | Module 2 | 2
2 | Phase 2 | Module 2 | 10
2 | Phase 3 | Module 2 | 4
For now I create different pivot tables and diagrams and analyze the differences "by hand" to make decisions like
for build index 1 the module 2 is build X seconds faster than in build index 2
for build index 2 the phase 3 (sum of all modules) is build Y seconds faster than in build index 1
That's what I want to do:
Because there are many phases and the count of modules is increasing continuously, the above procedure takes too much time and I think there's an automatic way to perform analyzes like these.
So, do you have any idea if there's a way to realize my intention? Feel free to provide hints for excel formulas or pivot tables or vba or or or :-)
I solved it using VBA. Never worked before with it, so my code could be improved ;-)
Call AllInOne for phases (any variable used is declared as String):
Option Explicit
Sub ExtractUniquePhasesAndModules()
'--------------------------------------
'| Perform calculations for TEST DATA |
'--------------------------------------
srcSheet = "CompareData"
destSheet = "CompareResults"
destPkColumn = "A"
destColumn = "B"
calculateColumn = "C"
'Phases 1
srcPkCell = "A2"
srcColumn = "B"
sumValuesColumn = "D"
AllInOne srcSheet, srcColumn, destSheet, destColumn, calculateColumn, sumValuesColumn, srcPkCell, destPkColumn
'Phases 2
srcPkCell = "F2"
srcColumn = "G"
sumValuesColumn = "I"
AllInOne srcSheet, srcColumn, destSheet, destColumn, calculateColumn, sumValuesColumn, srcPkCell, destPkColumn
End Sub
And this is the problem solving function:
Private Sub AllInOne(srcSheetName As String, srcColumnName As String, destSheetName As String, _
destColumnName As String, calculateColumnName As String, sumValuesColumnName As String, _
srcPkCellName As String, destPkColumnName As String)
Dim srcSheet As Worksheet
Dim destSheet As Worksheet
Dim srcColumn As Range
Dim destColumn As Range
Dim srcPkCell As Range
Dim destPkColumn As Range
Dim sumValuesColumn As Range
Dim wsf As WorksheetFunction
Set srcSheet = Worksheets(srcSheetName)
Set srcColumn = srcSheet.Range(srcColumnName + ":" + srcColumnName)
Set destSheet = Worksheets(destSheetName)
Set destColumn = destSheet.Range(destColumnName + ":" + destColumnName)
Set srcPkCell = srcSheet.Range(srcPkCellName)
Set destPkColumn = destSheet.Range(destPkColumnName + ":" + destPkColumnName)
Set sumValuesColumn = srcSheet.Range(sumValuesColumnName + ":" + sumValuesColumnName)
Set wsf = WorksheetFunction
'-----------------------
'Copy all unique values|
'-----------------------
destSheet.Select
Dim ctr As Range
'find the first empty cell
For Each ctr In destColumn.Cells
If ctr.Value = "0" Then
'do nothing
ElseIf ctr.Value = Empty Then
Exit For
End If
Next
'start copying
srcColumn.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ctr, Unique:=True
'set destination range to only the new cells
Set destColumn = destSheet.Range(ctr.Address + ":" + destColumnName & destColumn.Count)
Dim cell As Range
Dim calcCell As Range
Dim destPkCell As Range
For Each cell In destColumn.Cells
'end of list reached?
If cell.Value = Empty Then
Exit For
End If
'Fill in primary key
Set destPkCell = destSheet.Range(destPkColumnName & cell.Row)
destPkCell.Value = srcPkCell.Value
'Perform the sum-calculation and show the result
Set calcCell = destSheet.Range(calculateColumnName & cell.Row)
calcCell.Value = wsf.SumProduct(wsf.SumIf(srcColumn, "=" & cell.Value, sumValuesColumn))
Next
End Sub
First it iterates over the destination column to find the first empty cell. This cell is then used as CopyToRange argument in the AdvancedFilter function.
Then it inserts the primary key (BuildIndex in my case) and the result of SumProduct for every row.
The result for phases using the questions data is this:
1 | Phase | 0
1 | Phase 1 | 11
1 | Phase 2 | 5
1 | Phase 3 | 15
2 | Phase | 0
2 | Phase 1 | 5
2 | Phase 2 | 17
2 | Phase 3 | 13
Now I'm able to create diagrams just like I want :-)
I have a table that looks like this:
| A | B | C | D |
+-------+------------+------------+------------+
1 | Name | Language 1 | Language 2 | Language 3 |
+=======+============+============+============+
2 | John | English | Chinese | Spanish |
3 | Wendy | Chinese | French | English |
4 | Peter | Spanish | Chinese | English |
And I want to generate a table that has only one language column. The other two language columns should become new rows like this:
| A | B |
+-------+----------+
1 | Name | Language |
+=======+==========+
2 | John | English |
3 | John | Chinese |
4 | John | Spanish |
5 | Wendy | Chinese |
6 | Wendy | French |
7 | Wendy | English |
8 | Peter | Spanish |
9 | Peter | Chinese |
10 | Peter | English |
I understand this will probably will need a macro or something. If anybody point me in the right direction it would me much appreciate. I am not very familiar with VBA or the Excel object model.
This will do the trick. It is also dynamic supports as many language columns as you want with as many languages per person.
Assumes the data is formatted as per the example:
Sub ShrinkTable()
Dim maxRows As Double
Dim maxCols As Integer
Dim data As Variant
maxRows = Cells(1, 1).End(xlDown).row
maxCols = Cells(1, 1).End(xlToRight).Column
data = Range(Cells(1, 1), Cells(maxRows, maxCols))
Dim newSht As Worksheet
Set newSht = Sheets.Add
With newSht
.Cells(1, 1).Value = "Name"
.Cells(1, 2).Value = "Column"
Dim writeRow As Double
writeRow = 2
Dim row As Double
row = 2
Dim col As Integer
Do While True
col = 2
Do While True
If data(row, col) = "" Then Exit Do 'Skip Blanks
'Name
.Cells(writeRow, 1).Value = data(row, 1)
'Language
.Cells(writeRow, 2).Value = data(row, col)
writeRow = writeRow + 1
If col = maxCols Then Exit Do 'Exit clause
col = col + 1
Loop
If row = maxRows Then Exit Do 'exit cluase
row = row + 1
Loop
End With
End Sub
Messy but should work:
For Each namething In Range("A1", Range("A1").End(xlDown))
Range("A1").End(xlDown).Offset(1, 0) = namething.Value
Range("A1").End(xlDown).Offset(0, 1) = namething.Offset(0, 2)
Range("A1").End(xlDown).Offset(1, 0) = namething.Value
Range("A1").End(xlDown).Offset(0, 1) = namething.Offset(0, 3)
namething.Offset(0, 2) = ""
namething.Offset(0, 3) = ""
Next
Then just sort
The following formula should work. The data in sheet2 would always reflect the data on sheet1 so you wouldn't have to re-run a macro to create a new list.
That being said, using a macro to generate it is probably a better choice as it would allow more flexability should you need to add a 4th language or something at a later date.
In Sheet2!A2
=INDIRECT("Sheet1!A"&ABS(INT((ROW()+1)/3))+1)
In Sheet2!B2
=INDIRECT("Sheet1!"&IF(ABS(INT((ROW()+1)/3)-(ROW()+1)/3)=0,"B",IF(ABS(INT((ROW()+1)/3)-(ROW()+1)/3)=(1/3),"C","D"))&ABS(INT((ROW()+1)/3))+1)
Add the column titles in A1 and B1 then autofill the formula down the sheet.