VBA Subroutine to fill formula down column - vba

I have a current Sub that organizes data certain way for me and even enters a formula within the first row of the worksheet, but I am running into the issue of wanting it to be able to adjust how far down to fill the formula based on an adjacent column's empty/not empty status. For example, each time I run a report, I will get an unpredictable amount of returned records that will fill out rows in column A, however, since I want to extract strings from those returned records into different Columns, I have to enter formulas for each iteration within the next three columns (B, C, and D). Is there a way to insert a line that will evaluate the number of rows in Column A that are not blank, and then fill out the formulas in Columns B, C, and D to that final row? (I know that tables will do this automatically once information is entered in the first row, but for logistical reasons, I cannot use tables).
My current code that fills out the formula in Column B, Row 2 is:
Range("B2").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-1],FIND(""By:"",RC[-1])+3,22)"
Thanks!

The formula that you actually need is
=IF(A2="","",MID(A2,FIND("By:",A2)+3,22))
instead of
=MID(A2,FIND("By:",A2)+3,22) '"=MID(RC[-1],FIND(""By:"",RC[-1])+3,22)"
This checks if there is anything in cell A and then act "accordingly"
Also Excel allows you to enter formula in a range in one go. So if you want the formula to go into cells say, A1:A10, then you can use this
Range("A1:A10").Formula = "=IF(A2="","",MID(A2,FIND("By:",A2)+3,22))"
Now how do we determine that 10? i.e the Last row. Simple
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
'~~> Change the name of the sheet as applicable
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find Last Row in Col A
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B2:B" & lRow).Formula = "=IF(A2="""","""",MID(A2,FIND(""By:"",A2)+3,22))"
End With
End Sub
More About How To Find Last Row

You can use this to populate columns B:D based on Column A
Range("B2:D" & Range("A" & Rows.Count).End(xlUp).Row).Formula = _
"=MID($A2,FIND(""By:"",$A2)+3,22)"

Related

Copy separated columns from Active sheet to the first empty row of another sheet and merge both columns (in the target sheet)

I'm struggling to find a way to copy two different continuous ranges (with columns right next to each other, for example: A;B;C and the second G;H;I); and paste it into the first empty row of another sheet, but this time I would like them merged in a continuum. (What once was “A;B;C”, “G;H;I” now I want it all in the first empty row of a new sheet but now “A;B;C;D;F;G” – note that D;F;G are G;H;I)
The code that I come up with was this one but it justs pastes the second range bellow the first one
Sub copy ()
lastrowa = Sheets("DATA").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
ActiveSheet.Range("A5:T1346").Copy Sheets("DATA").Rows(lastrowa) &
_ActiveSheet.Range("AC5:AH1346").Copy Sheets("DATA").Rows(lastrowa)
End Sub
I also tried to concatenate but it just freezes the process (never understood if it was even correct)
Notice that for range A5:T1346 I want it to be followed by AC5:AH1346; merged into a continuum (meaning that AC column should become U column) in the first empty row of sheet “DATA”
Any sugestions
Thks in advance
Try,
Sub copy ()
dim lastrowa as long
lastrowa = workSheets("DATA").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
with ActiveSheet
.Range("A5:T1346").Copy workSheets("DATA").cells(lastrowa, "A")
.Range("AC5:AH1346").Copy workSheets("DATA").cells(lastrowa, "U")
end with
End Sub

Simplifying complex excel formula with VBA

I have a macro that is generally slow due to overuse of LOOKUP formulas. I want to insert some VBA variables to speed these up. I am currently working on speeding up the formula below:in Excel:
=IF(ISNA(MATCH(A2,Summary!B:B,0)),"n",I2-((I2/LOOKUP(2,1/(I:I<>""),I:I))*VLOOKUP(A2,Summary!$G$10:$H$902,2,FALSE)))
in VBA:
"=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-((RC[-1]/LOOKUP(2,1/(C[-1]<>""""),C[-1]))*VLOOKUP(RC[-9],Summary!R10C7:R902C8,2,FALSE)))"
The portion I need to replace is LOOKUP(2,1/(C[-1]<>""""),C[-1]). All this does is reference the last non empty cell in column I. Right now I have the following code to return the address of the last cell in VBA
Sub FormulaTest()
Set lRow = Range("I1").SpecialCells(xlCellTypeLastCell).Address
End Sub
I am trying to figure out how to implement this "lRow" into the VBA code for the formula. Can anyone steer me in the right direction?
**EDIT 1
Please see Fernando's comment below. He has the right idea however the solution is still off a bit. Ill try to explain it better in a few comments: First off, The first row is always a title row, the last row is always a sum row, the current tab is the "Sales" tab, and the amount of rows in any given Sales tab will vary (could be I1:I59, could be I:1:I323).
In this example I1 is a row title and I59 is the sum of I2:I58. Rows I2:I58 are dollar amounts. My macro places this formula in J2:J58. This formula takes each row's dollar amount (I2:I58) as a percentage of the total (I59) and multiplies it by an input amount on the Summary tab (the VLOOKUP). This amount is then subtracted proportionately from the dollar value in column I with the J cell showing the result.
I am looking to eliminate the need for the LOOKUP function (selects last non empty cell) within my formula above: LOOKUP(2,1/(C[-1]<>""""),C[-1]).
**EDIT 2
Fernando's solution worked. Thank you all for your input
This would return the last non-empty row in column I
with Worksheets("Summary")
lRow = .Cells(.Rows.Count, "I").End(xlUp).Row
end with
So your code would be
sub testy
dim lRow as long
with Worksheets("Summary")
lRow = .Cells(.Rows.Count, "I").End(xlUp).Row
end with
"=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-_
((RC[-1]/R"&lRow&"C[-1])*VLOOKUP(RC[-9],Summary!R10C7:R902C8,2,FALSE)))"
In your solution you're using xlCellTypeLastCell. This is very useful, but it calculates based on UsedRange, which may not be what you want. with this, if you have data up to row n and then you update the data and now you have less records, the last row with xlCellTypeLastCell will still be n, so be careful with that.
Assuming that you are doing all your work on the active sheet, looking up to a "Summary" sheet:
Sub fillCol()
Dim aRow As Long, bRow As Long
aRow = Cells(Rows.Count, "I").End(xlUp).Row
bRow = Sheets("Summary").Cells(Rows.Count, "I").End(xlUp).Row
Range("J2:J" & aRow).FormulaR1C1 = "=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-" _
& "((RC[-1]/" & aRow & ")*VLOOKUP(RC[-9],Summary!R10C7:R" & bRow & "C8,2,FALSE)))"
End Sub
You made need to change the columns which contain the contiguous range (in order to determine the last row)

Faster Workflow

I have a table (Table 1) with a whole bunch of well data (versions, MD, HD, etc.) and I want to create another table (Table 2) that will only show the data for the well I am interested in.
I have it set up where you select the well using a drop down list. Then I want Table 2 to be populated with four values for each of the iterations that show up in Table 1....
I tried using vlookup but was having issues when a well had multiple versions. And I also tried using an advanced filter.
Screenshot of the spreadsheet
Let's solve this using a helper column. First, assume column A will be used to the left of your table, to show the row number which each one of these is found in.
A5 would have the following formula:
=MATCH($C$1,K:K,0)
This shows us the row number that Well1 is first matched at. Then A6 and copied down would have the formula:
=A5+MATCH(B6,OFFSET(K1,A5,0,COUNT(M:M),1),0)
This uses OFFSET to create a new range, starting at the cell immediately below the previous match for Well1, and then uses MATCH to find what row that occurs.
So now, column A will always show the row number to pull data from. The rest is simply using the INDEX function to pull from your desired columns. For example, the data in column C pulls the iteration from column L, and can be pulled through formula like so, in cell C5 and copied to the right / down:
=INDEX(L:L,$A5)
If your data is appropriately normalized, you might be better off with a Pivot Table. This would give you the option of filtering by Well ID.
To use a Advanced filter you will need to create a worksheet event. Place this in the code for the sheet on which you want the data.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2")) Is Nothing Then
Dim dataRng As Range
Dim critRng As Range
Dim CpyToRng As Range
Dim cpytoarr() As Variant
With Worksheets("Sheet1")
Set dataRng = .Range(.Cells(1, 1), .Cells(1, 1).End(xlDown).End(xlToRight))
End With
With Me
.Range("CC1") = .Cells(1, 1).Value
.Range("CC2") = "'=" & .Cells(2, 1).Value
Set critRng = .Range("CC1:CC2")
Set CpyToRng = .Range(.Cells(6, 1), .Cells(6, 1).End(xlToRight))
End With
Debug.Print dataRng.Address
Debug.Print critRng.Address
Debug.Print CpyToRng.Address
dataRng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=critRng, CopyToRange:=CpyToRng, _
Unique:=False
critRng.ClearContents
End If
End Sub
How this works. This assumes the data is on Sheet1 and starts in "A1" with no blanks in column A or the last row:
On Sheet2 set it up like this:
It is important that the header rows on sheet2 are name identical to the headers on sheet1.
Now every time that the value changes in A2 on sheet 2, your drop down, the requisite data will appear below row 6.

Using loop and sum functions with Vlookup

I've got a macro that essentially searches column C in Sheet1 for the value "Rec" and copies the corresponding value in column D, then pastes it into the last open cell in column B of Sheet2. It does just what it is supposed to do and is as follows:
Sub FindPasteGSVInNextCell()
Worksheets("Sheet2").Activate
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
WorksheetFunction.VLookup("Rec", Sheet1.Range("C2:H25"), 2, False)
End Sub
I now want the code, instead of just searching for a single "Rec" value, to search for all rows with "Rec" in column C and to sum up all of their corresponding values in column D, then place that sum into Sheet2.
I am assuming that I need some kind of Do Until loop or something, but I am not exactly sure how to format it... I am a beginner with VBA, so any help would be greatly appreciated.
vlookup will not work as it will continue to only grab the first instance of "Rec".
On Sheet 2 list all the possible categories in column A then in column B1 put
= sumif(Sheet1!C:C,A1,Sheet1!D:D)
then copy down. This will Get you the totals by category.
If you want to use VBA, you will still need a list of categories setup somewhere, either hard coded or listed somewhere that you can loop through.
If your list was in column A on Sheet2 then you would:
dim ws as worksheet
set ws = Worksheets("Sheet2")
For each i in ws.range(ws.Range("A1"),ws.Range("A1").offset(xldown)).Cells
i.offset(,1) = WorksheetFunction.Sumif(Worksheets("Sheets1").Range("C:C"), _
i,Worksheets("Sheets1").Range("D:D"))
next i

I need a VBA code to count the number rows, which varies from ss to ss, return that number and copy and paste that row and all other columns

I have vba question I have been trying to find the answer for for a long time. I have numerous spreadsheets from numerous clients that I run macro's on, I'm new to coding and have been able to mostly figure out what I need to do. My clients send us data monthly and every month the number of rows change. The columns don't change but the amount of data does. My previous macro's I have just chosen the entire column to copy and paste onto our companies template. This worked fine for must things but has created some really long code and macros take a long time. I would like to write a code that counts how many rows are in a certain column and then from there copies and pastes that however many rows it counted in each column. Only a few columns contain data in every row, so I need it to count the rows in one specific column and apply to that every column. Any help would be appreciated.
Thanks
Tony
Hi Guys,
Still having issues with this, below I pasted the code I'm using if anyone can see why it won't run please help.
Windows("mmuworking2.xlsx").Activate
Workbooks.Open Filename:= _
"C:\Users\I53014\Desktop\QC DOCS\Sample_Data_Import_Template.xlsx"
Windows("mmuworking2.xlsx").Activate
Dim COL As Integer
COL = Range("A:DB").Columns.Select
**Range(Cells(2, COL), Cells(Range("E" & Rows.Count).End(xlUp).Row, COL)).Copy Destination:=Windows("Sample_Data_Import_Template.xlsx").Range("A2")**
Range("A2").Paste
Range("A5000").Formula = "='C:\Users\I53014\Desktop\[Import_Creator.xlsm]sheet1'!$B$2"
ActiveWorkbook.SaveAs Filename:="Range (A5000)", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
I bolded where it keeps stopping.
This should give you the last row containing data:
ActiveSheet.UsedRange.Rows.Count
This will give you the last row in a specific column:
Range("B" & Rows.Count).End(xlUp).Row
here is an example of how I can copy every row in the first three columns of a worksheet
Sub Example()
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
Range(Cells(1, 1), Cells(LastRow, 3)).Copy Destination:=Sheet2.Range("A1")
End Sub
You have to be careful as there are some caveats to both methods.
ActiveSheet.UsedRange may include cells that do not have any data if the cells were not cleaned up properly.
Range("A" & Rows.Count).End(xlUp).Row will only return the number of rows in the specified column.
Rows(Rows.Count).End(xlUp).Row will only return the number of rows in the first column.
Edit Added an example
Edit2 Changed the example to be a bit more clear
For this example lets say we have this data
You could copy any other column down to the number of rows in column A using this method:
Sub Example()
Dim Col as Integer
Col = Columns("C:C").Column
'This would copy all data from C1 to C5
'Cells(1, Col) = Cell C1, because C1 is row 1 column 3
Range(Cells(1, Col), Cells(Range("A" & Rows.Count).End(xlUp).Row, Col)).Copy Destination:=Sheet2.Range("A1")
End Sub
The end result would be this: