Subtracting from a column based on column names instead of column indexes - vba

I have a column named "Re-Align Midpoint" whose result is the date of another column (named "Final Execution Date") minus 100 days. Right now, the "Re-Align Midpoint" date is in column AZ while "Final Execution Date" is in column BR. These columns are subject to be moved around, so it is impractical for me to build a macro based on column indexes. What I would like to do instead is subtract one from the other based on column names. The header rows are on row 2, not row 1
This is what I have for my recorded macro:
Sub Re_Align_Midpoint_Date
Range("AZ3").Select
ActiveCell.FormulaR1C1 = "=RC[18] - 100"
Range("AZ3").Select
Selection.AutoFill Destination:=Range("AZ3:AZ142"), Type:=xlFillDefault
Range("AZ3:AZ142").Select
ActiveWindow.SmallScroll Down:=-132
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

As long as the column headings won't change you can use an hLookup to do this:
=HLOOKUP("Final Execution Date",$A$2:$ZZ3,ROW(A2),FALSE)-100
Just paste this formula at the top of your "Midpoint" column and fill down.

Related

Dragging Formulas into next blank column and pasting values on previous column

I'm looking to use a macro to drag formulas from the end column to the next blank column and then paste values on the previous column.
For example, column V contains the formulas at first. I want to then drag these formulas into column W (blank column) and Paste Values in column V, but I want to write the code in a way that when it comes to using the macro again the formulas that are now in column W will be dragged into column X and then have their values pasted in column X.
This is what I've got so far:
Sub RollFile()
Columns("V3:V114").Select
Selection.AutoFill Destination:=Columns("V3:W114"), Type:=xlFillDefault
Columns("V3:V114").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("W2").Select
End Sub
Any help would be great.
I would recommend using the Range.Cells property- https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-cells-property-excel
Essentially, Columns("V3:V114") in your code would be replaced by something like
Range(Cells(3, 22), Cells(114, 22))
Now you can use variables instead of the numbers to iterate using a loop.

How to Match 2 rows in excel spreadsheet by 2 columns?

I have an issue where I'm currently using several queries to achieve the outcome I want, but when run on larger spreadsheets it slows down substantially. Some info:
The Excel workbook in question has the .xlsx extension;
The two sheets in the Excel file are Matched and `Unmatched';
Connection type can use either ODBC or OleDB;
All data that needs to be matched is located on one sheet in Excel;
Matched data needs to be in pairs so must equal 2;
The 2 columns to be matched are Receipt and Amount where the Receipt on the two rows must match exactly and the Amount value for both rows must balance or equal 0. One Amount value will have a negative sign (-) at the beginning of it so the amounts can be added together to balance out, but they are on separate rows;
The number of rows can range from a couple hundred to several thousand (~60,000); and
If the two rows match/balance by Receipt and Amount, then they need to be moved into the Matched sheet in the same Excel file.
Scripts are not out of the question, VBScript and Powershell are welcome.
Example:
As you can see in the Excel example, I need to match 2 rows where the Receipt value matches exactly, and the Amount values balance. If both conditions are met, then I need to insert said rows into the Matched sheet. So in this example, both rows with 101010 in the Receipt column (rows 2 and 3) have amounts that balance in the Amount column, so they would be moved to Matched as both conditions are met. The remaining two values in Receipt match, but their Amount values do not balance, so the conditions would not be met for them.
The limitations are the statements available to the ODBC and OleDB connections. I am currently using several queries to match and return the row count of the above conditions and if it equals two, then I know to insert all rows of that Receipt number into the Matched sheet; however, like I said, I need it to be more efficient and to perform faster.
Here's a VBA suggestion - it expects the original data to be in a tab called 'Original' and will sort on Receipt, then do a couple of formulas to determine receipt#'s that tally to zero then creates a new tab called 'Match' with matched receipt rows and another called 'Unmatch' with unmatched receipts.
Sub TallySplit()
vLR = Cells(Rows.Count, 1).End(xlUp).Row
ActiveWorkbook.Worksheets("Original").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Original").Sort.SortFields.Add Key:=Range("A2:A" & vLR), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Original").Sort
.SetRange Range("A1:D" & vLR)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("E2").Select
ActiveCell.FormulaR1C1 = "=IF(R[-1]C[-4]=RC[-4],R[-1]C[-3] + RC[-3],RC[-3])"
Range("E2").Select
Selection.AutoFill Destination:=Range("E2:E" & vLR)
Range("E2:E" & vLR).Select
Range("F2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5]=R[1]C[-5],R[1]C,RC[-1])"
Range("F2").Select
Selection.AutoFill Destination:=Range("F2:F" & vLR)
Range("F2:F" & vLR).Select
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$F$" & vLR).AutoFilter Field:=6, Criteria1:="<>0", _
Operator:=xlAnd
Range("A1:D" & vLR).Select
Selection.Copy
Sheets.Add.Name = "Unmatch"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Original").Select
ActiveSheet.Range("$A$1:$F$" & vLR).AutoFilter Field:=6, Criteria1:="=0", _
Operator:=xlAnd
Range("A1:D" & vLR).Select
Selection.Copy
Sheets.Add.Name = "Match"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

count records from two date criteria

hope I can get any help on this.. I have tried counting records which are meeting two dates criteria (date criteria are dynamic so will keep changing, I have put it on next sheet from the data here is code I am trying to run which is bringing me blank result here is my code which I have gathered so far using macro:
Worksheets("Data").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$BN$235").AutoFilter Field:=4, Criteria1:="=COUNTIFS(DOB," >= "&R[1]C,DOB,""<=""&R[1]C[1])"
ActiveWindow.SmallScroll Down:=-9
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Set NewSheet = Sheets.Add(After:=Worksheets("error"))
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
NewSheet.Name = "DOBrange"
NewSheet.Range("A1").Select
Application.CutCopyMode = False
Worksheets("Data").Select
Worksheets("Data").Range("A1").Select
You appear to be trying to filter rows by selecting values between two dates, however your criteria is saying you want to select values equal to something (which seems to be attempting to say all values equal to the count of values that have dates between two other dates - so if five dates were within the range, you are attempting to say filter to show all values that are 5).
The correct way to select values between two dates would be by saying:
ActiveSheet.Range("$A$1:$BN$235").AutoFilter _
Field:=4, _
Criteria1:=">=" & Worksheets("Error").Range("A20").Value2, _
Operator:=xlAnd, _
Criteria2:="<=" & Worksheets("Error").Range("B20").Value2
(assuming the two dates are in cells A20 and B20 of worksheet "error")
You have problem at the criteria1 statement
Criteria1:="=COUNTIFS(DOB," >= "&R[1]C,DOB,""<=""&R[1]C[1])"
You can see that text color of >= is black while other is brown. this mean vba will compare between "=COUNTIFS(DOB," and "&R[1]C,DOB,""<=""&R[1]C[1])" then criteria1 will be True or False. so you will not get the result vary by your condition
The code below may fix this problem
Criteria1:="=COUNTIFS(DOB, "">=""" & R[1]C & ",DOB,""<=""" & R[1]C[1] & ")"

VBA code Fill down visible column after filter another column

I need help with my code. I am new to VBA so not quite understand to do this right. Already search answer from another thread but it too advance I cannot follow it.
Here the situation I want.
at column S I use vlookup to find match data from sheet3 and filter with N/A value. then I want to fill down visible data in column Q with "Fulfilled" but I what get is it fill my Q2 with header value and do not fill to last row.
Sheets("Sheet1").Select
Range("S2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
' vlookup from sheet3
Range("S2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-14],Sheet3!C[-16],1,0)"
Selection.AutoFill Destination:=Range("S2:S" & Range("E" & Rows.Count).End(xlUp).Row)
Range("S2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("S2").Select
ActiveSheet.Range("$A$1:$S$20000").AutoFilter Field:=19, Criteria1:="#N/A"
' here it don't fill to last row
Range("Q2").Select
ActiveCell.FillDown
Many thanks for you help.
Autofill needs to know the range to autofill, not only the top cell. Supposing the only problem you have is in the last part, try this instead:
With ActiveSheet.UsedRange
.Resize(.Rows.Count - 1).Offset(1).Columns("B"). _
SpecialCells(xlCellTypeVisible).FillDown
End With
Or it could be .value = "Fulfilled" instead of .Filldown, depending on what you want to do.
That said, think of refactoring your code to get rid of the Select, ActiveSheet and Copy/Paste stuff` and work with qualified ranges.

columns property for pasting the row

Hello I have the code for copying the particular row and paste it in particular column
the code is
Range(rng, rng.End(xlToRight)).copy
Columns(c).Offset(, 6).PasteSpecial Transpose:=True
It is working correctly
But when i wanted to start pasting it from 2 cell of particular column i,e
Range(rng, rng.End(xlToRight)).copy
Columns(c).Offset(2, 6).PasteSpecial Transpose:=True
it is giving
"object defined error"
please help me
This should work:
Cells(2, Cells(1,Columns(c).Column).offset(,6).Column).PasteSpecial Transpose:=True
In the above ling you are selecting Row 2 by Cells(2, and 6 columns to the right of whatever c is by Columns(c).Column).Offset(,6).Column)
The reason that Columns(c).Offset(2,6) does not work is because you are telling excel to Offset an Entire Column by 2 rows, which you can't since it would effectively push the data off the worksheet.
You can offset EntireColumns for a given number of columns and EntireRows for a given number of rows, but not EntireColumns by Rows and EntireRows by Columns.
You can't offset a column by row, column is always whole. You should offset a cell.
Columns(c).cells(1).Offset(1, 6).PasteSpecial Transpose:=True
or
Columns(c).cells(2).Offset(, 6).PasteSpecial Transpose:=True
or
Columns(c).cells(2, 7).PasteSpecial Transpose:=True
or
cells(2, c+6).PasteSpecial Transpose:=True