Copying a Row from a Table using a cell that contains a VLOOKUP equation - vba

I am pretty unfamiliar with VBA, and I am stuck with this portion of my code. I have a cell with a vlookup equation in it I'd like to use as a parameter to find a value in a table on a different sheet and copy the entire row over to a different sheet. I've used this code in the past to copy data over based on a single parameter, but I think the problem I'm running into is that the cell I'm trying to reference contains a vlookup equation in it.
Sub Test()
For Each cell In Sheets(RawDataLoader).Range("E:E")
If cell.Value = "B8" Then
matchRow = cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Dashboard").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("RawDataLoader").Select
End If
Next
End Sub
RawDataLoader is the sheet with my table
Dashboard is the sheet where I want the cells to go
B8 is the cell on the sheet Dashboard I want to use as the value the table looks up.
The range with the values I want it to search through is E:E and on the RawDataLoader sheet.
I know that the cell.value portion of my code is incorrect, I just do not know how to reference a cell value, so I put the cell I wanted to reference.
Thank you!

You just need to use Sheets("Dashboard").Range("B8").value instead of "B8". You can also simplify your code; avoid using Select and loop only on the used range instead of the full column.
Sub Test()
Dim cell as Range
For Each cell In Intersect(Sheets("RawDataLoader").UsedRange, Sheets("RawDataLoader").Range("E:E"))
If cell.Value = Sheets("Dashboard").Range("B8").value Then
cell.EntireRow.copy Sheets("Dashboard").Rows(cell.Row)
End If
Next
End Sub

Related

ClearContents for constants but not formulas

I've got a range (N1:N12) on a sheet1 and I've got a code that copy and paste me the values of that range on a secondary sheet2. Everything is working, anyway i didn't consider that i want another button that clear only values in range N1:N12 once i have copied them in sheet2. I don't know how to keep formulas on that range when i want to delete values. Do you have an idea ? I've already tried a normal macro that deletes everything but it is not what i want.
Sub Cancella()
Sheets("Foglio1").select
Range("N1:N12").clearcontents
End Sub
The code i use for copying
Dim lastRow As Long
Sheets("Training Analysis").Range("P1:R13").Copy
lastRow = Sheets("Foglio1").Range("a65536").End(xlUp).Row
Sheets("Foglio1").Range("A" & lastRow + 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Replace:
Range("N1:N12").clearcontents
with:
For i = 1 To 12
If Not Cells(i, "N").HasFormula Then Cells(i, "N").ClearContents
Next i
There is a subset of the Range.SpecialCells method that targets xlCellTypeConstants. This can be further broken down to xlNumbers, xlTextValues, xlErrors , xlLogical or a combination of same.
With WorkSheets("Foglio1")
.Range("N1:N12").SpecialCells(xlCellTypeConstants, xlNumbers).ClearContents
End With
Conversely, cells containing formulas can be similarly targeted with the xlCellTypeFormulas subset.

Excel: Copy and insert rows on another sheet based on cell

I'm trying to make a code that checks for numbers in a master sheet called All in column D (ex. 780101) and if it meets the criteria, it copies the whole row and inserts (not paste) it to another sheet with the name of the criteria (ex. 780101), starting on row 6.
The code I have doesn't work like I want it to. It doesn't copy all the rows that meet the criteria and sometimes it inserts blank rows.
Sub Insert()
For Each Cell In Sheets("All").Range("D:D")
If Cell.Value = "780101" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow + 1).Select
Selection.Copy
Sheets("780101").Select
Rows("6:6").Select
Selection.Insert Shift:=xlDown
End If
Next
End Sub
I'm just starting to learn VBA, so if it could be possible the names of the sheets would be the criteria of the cell values (the code is made for only one sheet - 780101, but there are 20 of sheets with different names).
It's tough to make recommendations without seeing sample data and what could potentially be causing the problems you are having but you can run this rehash of your existing code.
Sub Insert()
Dim dc As Range
With Sheets("All")
For Each dc In Intersect(.Range("D:D"), .UsedRange)
If dc.Value2 = 780101 Then
dc.Resize(2, 1).EntireRow.Copy
Sheets("780101").Rows(6).Insert Shift:=xlDown
End If
Next
End With
End Sub
The nature of running that from top to bottom means that the results will be reversed. You may wish to consider running the main loop from bottom to top to maintain the order.

VBA code in Excel to add a row to multiple sheets and then copy formula from adjacent row

I'm really hoping someone can help me with this one. I have recorded a macro to use within a sheet that needs to create a row at the same position on 2 worksheets and then, on one of them, copy the formula's in the cells from the row below it. The code I have looks like this -
Sub Macro1()
Sheets(Array("SCHEDULE", "ANNUAL SUMMARY")).Select
Sheets("SCHEDULE").Activate
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("ANNUAL SUMMARY").Select
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.AutoFill Destination:=ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow _
, Type:=xlFillDefault
ActiveCell.Offset(-1, 0).Rows("1:2").EntireRow.Select
Sheets("SCHEDULE").Select
ActiveCell.Select
My problem is, when I run it manually and then record the macro, it does exactly what I want it to, but when I run this from a button on the "SCHEDULE" sheet it does not copy the formula's from the row below the one on the "ANNUAL SUMMARY" sheet.
Can anyone help to get this working with me?
Thanks all in advance
Mark
The problem with the macro recorder is that although it can give you a good indication of what code you need, it also generates very inefficient code and includes all of the select and activate statements that you need to try and avoid using.
Any reference in the code to ActiveCell is referring to the cell that is currently selected and ActiveSheet is the sheet that is currently selected. This can give you undesired results if you run the macro from a different sheet that the macro was recorded from...
If you wanted to copy row 1 from SCHEDULE sheet then you can use
Sheets("SCHEDULE").Rows(1).Copy Sheets("ANNUAL SUMMARY").Rows(1)
If you want to auto fill a range, then this can be accomplished with a single line of code
This will auto fill the contents of row1 (column A - E) down to row 100 in your ANNUAL SUMMARY sheet
Sheets("ANNUAL SUMMARY").Range("A1:E100").FillDown
So if we put it all together and include some declarations for our source and destination sheet to make the sub more readable..
Sub CopyAndFillDownExample()
Dim rowNumber As Long, offset As Long
Dim sourceSht As Worksheet, destinationSht As Worksheet
'set the source and destinationsheets
Set sourceSht = Sheets("SCHEDULE")
Set destinationSht = Sheets("ANNUAL SUMMARY")
'number of rows to copy down
offset = 100
'get currently selected row
rowNumber = ActiveCell.Row
'copy the selected row from the source sheet to the destination sheet
sourceSht.Rows(rowNumber).Copy destinationSht.Rows(rowNumber)
'fill down the formulas
destinationSht.Rows(rowNumber & ":" & rowNumber + offset).FillDown
End Sub

VBA Go to last empty row

I have a project on excel macro, I need to highlight the next last row that has an empty value. example cell A1:A100 have data and the next cell is A101 is empty.
when user click a button it should highlight the cell A101...
If you are certain that you only need column A, then you can use an End function in VBA to get that result.
If all the cells A1:A100 are filled, then to select the next empty cell use:
Range("A1").End(xlDown).Offset(1, 0).Select
Here, End(xlDown) is the equivalent of selecting A1 and pressing Ctrl + Down Arrow.
If there are blank cells in A1:A100, then you need to start at the bottom and work your way up. You can do this by combining the use of Rows.Count and End(xlUp), like so:
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
Going on even further, this can be generalized to selecting a range of cells, starting at a point of your choice (not just in column A). In the following code, assume you have values in cells C10:C100, with blank cells interspersed in between. You wish to select all the cells C10:C100, not knowing that the column ends at row 100, starting by manually selecting C10.
Range(Selection, Cells(Rows.Count, Selection.Column).End(xlUp)).Select
The above line is perhaps one of the more important lines to know as a VBA programmer, as it allows you to dynamically select ranges based on very few criteria, and not be bothered with blank cells in the middle.
try this:
Sub test()
With Application.WorksheetFunction
Cells(.CountA(Columns("A:A")) + 1, 1).Select
End With
End Sub
Hope this works for you.
This does it:
Do
c = c + 1
Loop While Cells(c, "A").Value <> ""
'prints the last empty row
Debug.Print c

Match cell value from two sheets and paste where the value is met, starting from one cell below

I'm new to VBA, I'm using Microsoft Office Excel 2007 and I read the forums but this seems impossible for me. I have the current code which copies a sheet and adds a day to the date and also copies a range of cells containing the important information from the sheet to be able to paste it in a calendar with realtime information and I need it to paste where the date is the same and one cell below the value which could be located in any place in a certain range.
Sub CopierPetete()
ActiveWorkbook.ActiveSheet.Copy _
After:=ActiveSheet
'update date
[J1].Value = [J1].Value + 1
'THIS IS MY POOR ATTEMPT TO MAKE IT WORK
If Sheets("Sheet5").Range("A1:K100").Value = ActiveSheet.Range("J1").Value Then _
ActiveSheet.Range("AA100:AC121").Select
Selection.Copy
Sheets("Sheet5").Select
Sheets("Sheet5").Pictures.Paste Link:=True
End If
End Sub
I need it to match the value in the ActiveAheet cell J1 with any cell on Sheet5, and paste as Pictures.Paste Link=True (or, if you have a better idea for a way to display real-time information) at the place where the value is met on Sheet5, one cell below.
Here's a link to the project!
If I understand well, what you intend to do is to check if the value of the ActiveSheet > cell J1 exists in the Sheet named "Sheet5" within the range A1 to K100. Meaninly, if Excel finds any cell withing A1 to K100 matching the J1 value, copy-paste the picture.
Here is a try:
Sub CopierPetete()
Dim rFind as Range
ActiveWorkbook.ActiveSheet.Copy _
After:=ActiveSheet
'update date
[J1].Value = [J1].Value + 1
'Find returns a range object, so we use Set
Set rFind = Worksheets("Sheet5").Range("A1:K100").Find(ActiveSheet.Range("J1").Value, LookIn:=xlValues, lookAt:=xlWhole)
If Not rFind is Nothing Then
ActiveSheet.Range("AA100:AC121").Copy
Worksheets("Sheet5").Activate
Worksheets("Sheet5").Range(rFind.Address).Offset(0, 1).Activate
Worksheets("Sheet5").Pictures.Paste Link:=True
End If
End Sub