I'm working on the below formula to Vlookup data from another sheet. The formula must be placed on the 14th column, and every 7 rows, vlookuping the first column value.
Sub test3()
'Vlookuping on Column N
Dim lastRow As Long
lastRow = Cells(Rows.Count, 14).End(xlUp).Row 'Checks last row with data
Dim cel As Range, rng As Range
Dim sheetName, lookupFrom, myRange 'variables
sheetName = "Plan2" 'the worksheet i want to get data from
lookupFrom = ActiveCell.Offset(0, -14).Address '
myRange = "'" & sheetName & "'!1:1048576"
For i = 3 To lastRow Step 7 '
Cells(i, 14).Select 'i= first value; step= lines to jump
ActiveCell.Formula = "=VLOOKUP(" & lookupFrom & ";" & myRange & "; 14; FALSE)"
Next i
End Sub
Example Sheet
I want to place the formula on the pink cells (column N), vlookuping the pink value from the first cell on another worksheet. My actual formula isn't even executing.
Try the code below, with 2 exceptions:
1.Modify "VlookRes" to your Sheet name - where you want to results to be.
2.You have Merged Cells in Column A (according to your image uploaded), you are merging Rows 2 untill 6 in column A, this means that the value of Cell A3 will be 0. If you want the values to read from the third row, start the merging from row 3 (and soon for the next values in Column A).
Option Explicit
Sub test3()
'Vlookuping on Column N
Dim ShtPlan As Worksheet
Dim ActSht As Worksheet
Dim lastRow As Long
Dim sheetName As String
Dim lookupFrom As String
Dim myRange As String
Dim i As Long
' modify this Sheet Name to your sheet name (where you want to keep your results)
Set ActSht = Sheets("VlookRes")
lastRow = ActSht.Cells(ActSht.Rows.Count, 14).End(xlUp).Row ' Checks last row with data
sheetName = "Plan2" 'the worksheet i want to get data from
Set ShtPlan = Sheets(sheetName)
myRange = "'" & sheetName & "'!1:1048576"
For i = 3 To lastRow Step 7
lookupFrom = ActSht.Cells(i, 1).Address ' ActiveCell.Offset(0, -14).Address '
Cells(i, 14).Formula = "=VLOOKUP(" & lookupFrom & "," & myRange & ", 14, FALSE)"
Next i
End Sub
Related
I have the below code where in all other columns there is many populated rows, what I need this formula to do in column F is to find the first blank, then place the formula in it and fill it down to the last row.
What is currently happening is I have the range as F26 as this is usually first blank but this could change and I want the code to identify this and also have the formula dynamically know what row it is on, so for example if one month the first blank was in cell F30 the range would find it and the formula would start as E30*G30.
Any help would be greatly appreciated.
Private Sub calc()
Dim lastrow As Long
Dim rng As Range
lastrow = ThisWorkbook.Worksheets("Indiv").Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("F26:F" & lastrow)
rng.Formula = "=Round((E26*G26),2)"
End Sub
You need to find the first free row in column F and then bulid your formula with this row:
Option Explicit
Private Sub calc()
Dim ws As Worksheet ' define worksheet
Set ws = ThisWorkbook.Worksheets("Indiv")
Dim LastRowA As Long ' find last used row in column A
LastRowA = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
Dim FirstFreeRowF As Long ' find first free row in column F (if first 2 rows have data)
FirstFreeRowF = ws.Cells(1, "F").End(xlDown).Row + 1
' fix issue if first or second row is empty
If FirstFreeRowF = ws.Rows.Count + 1 Then
If ws.Cells(1, "F").Value = vbNullString Then
FirstFreeRowF = 1
ElseIf ws.Cells(2, "F").Value = vbNullString Then
FirstFreeRowF = 2
End If
End If
' define range to add formula
Dim Rng As Range
Set Rng = ws.Range("F" & FirstFreeRowF, "F" & LastRowA)
' add formula
Rng.Formula = "=Round((E" & FirstFreeRowF & "*G" & FirstFreeRowF & "),2)"
End Sub
So this will consider F5 the first free row and fill in the formula in the selected range as seen below:
I think you should find the last used row in column F, so that you could know the next row is blank
lastrowF=sheets(sheetname).range("F" & rows.count).end(xlup).row
So the next row would be like
range("F" & lastrowF+1).formula="Round((E" & lastrowF+1 & "*G" & lastrowF+1 & ",2)"
So I have what might be a simple issue. I have a worksheet where I'm just hoping to generate a row count starting with cell A4. So A4 = 1, A5 = 2 , etc. The problem is I'm not sure how to configure this with the following goal:
1 - I'm hoping the count starts with cell A4 and ends the count at the final row with data.
The code I have below only works if I manually put A4 = 1, and also populates formulas past the last row unfortunately.
Please help if this is possible.
Sub V14()
With ThisWorkbook.Worksheets("DCT")
.Cells(5, 1).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 1).Formula = "=IF(DCT!B5="""","""",DCT!A4+1)"
End With
End Sub
Write Formula to Column Range
The Code
Sub V14()
Const wsName As String = "DCT" ' Worksheet Name
Const tgtRow As Long = 4 ' Target First Row Number
Const tgtCol As String = "A" ' Target Column String
Const critCol As String = "B" ' Criteria Column String
' Define worksheet ('ws').
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(wsName)
' Define Last Non-Empty Cell ('cel') in Criteria Column ('critCol').
Dim cel As Range
Set cel = ws.Cells(ws.Rows.Count, critCol).End(xlUp)
' Define Target Column Range ('rng').
Dim rng As Range
Set rng = ws.Cells(tgtRow, tgtCol).Resize(cel.Row - tgtRow + 1)
' Define Target Formula ('tgtFormula').
Dim tgtFormula As String
tgtFormula = "=IF('" & wsName & "'!" & critCol & tgtRow _
& "="""","""",MAX('" & wsName & "'!" & tgtCol _
& "$" & tgtRow - 1 & ":" & tgtCol & tgtRow - 1 & ")+1)"
' Write Target Formula to Target Range.
rng.Formula = tgtFormula
' If you just want to keep the values:
'rng.Value = rng.Value
End Sub
I think you might just need an extra IF:
Sub V14()
With ThisWorkbook.Worksheets("DCT")
.Cells(4, 1).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 1).Formula = "=IF(DCT!B4="""","""",IF(A3="""",1,SUM(DCT!A3,1)))"
End With
End Sub
Report any question you have or bug you have encountered. If, according to your judgment, this answer (or any other) is the best solution to your problem you have the privilege to accept it (link).
Dim target As String
Dim lastrow As Long
target = "A4"
lastrow = ActiveSheet.UsedRange.Rows.count
'for example
Range(target) = "1"
Range(target).Offset(1, 0) = "2"
Range(Range(target),Range(target).Offset(1, 0)).Select
Selection.AutoFill Destination:=Range(target & ":A" & lastrow + Range(target).Row - 1), Type:=xlFillDefault
You only got to change the target cell, this does the rest.
I need to find the value of the last cell in column b of sheet1. This value will change weekly. I then want to take that value and find it in sheet2. Then I want to copy and paste all data below this found value to sheet3. I can't get past the first part with the following code:
Dim cell As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Set cell = Range("B:B").Find("rangefound")
rangefound = lastRow = Cells(lastRow, 2).Value
I've been struggling with the syntax for a month and really don't know what I'm doing.
try this
Sub test()
Dim cell As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
rangefound = Sheet1.Cells(lastRow, 2).Value
Set cell = Sheet2.Range("B:B").Find(rangefound)
MsgBox "The value was found in Sheet2!" & cell.Address
End Sub
The issues with your code were
using rangefound before it had a value, i.e. the order of the commands
using "rangefound" as a text instead of the variable
wrong syntax to assign a value to rangefound
not qualifying which sheet should be searched
Edit: To extend the code to copy the data below the found value to another sheet, use Offset to reference one row below. There are many different ways to do this, so using Offset is just one option.
Here is the complete code
Sub test()
Dim mycell As Range, RangeToCopy As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
rangefound = Sheet1.Cells(lastRow, 2).Value
' this is the cell with the found value
Set mycell = Sheet2.Range("B:B").Find(rangefound)
' now find the last row in Sheet2. We can use lastRow again,
' since it is no longer needed elsewhere
lastRow = Sheet2.Range("B" & Rows.Count).End(xlUp).Row
' set the range to copy to start one cell below rangefound
' to the end of the data in column B
Set RangeToCopy = Sheet2.Range(cell.Offset(1, 0), Sheet2.Cells(lastRow, "B"))
' copy the range and paste into Sheet3, starting at A1
RangeToCopy.Copy Sheet3.Range("A1")
End Sub
Note: I changed the variable name from "cell" to "mycell". It's better to use variable names that cannot be mistaken for Excel artifacts.
Another edit: If you need to paste into the next free row in Sheet3, use the techniques already established.
[...]
Set RangeToCopy = Sheet2.Range(cell.Offset(1, 0), Sheet2.Cells(lastRow, "B"))
' get the next available row in Sheet3
lastRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row + 1
' copy and paste
RangeToCopy.Copy Sheet3.Range("A" & lastRow)
[...]
Note that I'm using the same variable for three different purposes. If that is too confusing, create three distinct variables instead.
(not in a range, not adjacent columns)
(in given order)
I have many rows on Sheet1. I would like to copy some columns of a row (not the entire row and not a range of columns) to Sheet2 (to the first empty row of Sheet2) if a cell satisfies a condition (the cell in the current row and A column has a value of y)
I would like to copy not the entire row from Sheet1 only the row with those columns that are given on Sheet3 (Column A), and the new column number (on Sheet2) is also given on Sheet3 (column B)
It would be simple if my task would be to copy the entire row, or the selected column would be in a range...but i would need to copy those columns that are specialized on Sheet3. I would be grateful for any help. Thanks in advance.
Sheet1 shows an example data sheet. The criteria is if Cells(Rows, 1).Value = "y"
Sheet2 shows the desired result.
Sheet3 shows the selected column number on Sheet1 and the new column number on Sheet2
Whilst this probably should be done using arrays more, here's some basic VBA code that loops the first sheet checking for "y" in the first column. When it finds it, it then loops the column mappings in the third sheet that have been saved into arrays to set the values on the second sheet:
Sub sTranasferData()
On Error GoTo E_Handle
Dim aOld() As Variant
Dim aNew() As Variant
Dim wsIn As Worksheet
Dim wsOut As Worksheet
Dim wsTrack As Worksheet
Dim lngLastRow As Long
Dim lngLoop1 As Long
Dim lngLoop2 As Long
Dim lngRow As Long
Dim lngTrack As Long
Set wsIn = Worksheets("Sheet1")
Set wsOut = Worksheets("Sheet2")
Set wsTrack = Worksheets("Sheet3")
lngLastRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row
lngTrack = wsTrack.Cells(wsTrack.Rows.Count, "A").End(xlUp).Row
aOld() = wsTrack.Range("A2:A" & lngTrack).Value
aNew() = wsTrack.Range("B2:B" & lngTrack).Value
lngRow = 1
For lngLoop1 = 2 To lngLastRow
If wsIn.Cells(lngLoop1, 1) = "y" Then
For lngLoop2 = LBound(aOld) To UBound(aOld)
wsOut.Cells(lngRow, aNew(lngLoop2, 1)) = wsIn.Cells(lngLoop1, aOld(lngLoop2, 1))
Next lngLoop2
lngRow = lngRow + 1
End If
Next lngLoop1
sExit:
On Error Resume Next
Set wsIn = Nothing
Set wsOut = Nothing
Set wsTrack = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sTransferData", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Regards,
I realize there are a few different similar ideas on here. But I need help with this simple compare function.
My goal is to compare two different cells and if they are the same, replace it with its full non-abbreviated name.
Thank you for your time!!!
I.E
Sheet1 Sheet2
Column H Column A Column B
Dept Dept Department
This is what I have (Yes simple), but the cell H is not updating to the non-abbreviation:
Sub updateDeptNames()
'Format user ID from the email column
Dim ws As Worksheet, ws2 As Worksheet
Dim LastRow As Long, i As Long
Dim tmpArray() As String, tempDept As String
Set ws = ActiveWorkbook.Sheets("Student_Travel_DB") '--> This is the relevant sheet
Set ws2 = ActiveWorkbook.Sheets("gokoutd") '--> This is the relevant sheet
LastRow = 1000 ''Bug finding the last row, had to hard code it
For i = 2 To LastRow 'Iterate through all the rows in the sheet
For j = 2 To 112
tempDept = ws2.Range("A" & j).Value
If ws.Range("H" & i).Value = tempDept Then
ws.Range("H" & i) = ws2.Range("B" & j).Value
End If
Next j
Next i
End Sub
You can more easily use VLOOKUP either on your worksheet or with VBA:
Sub GetFullName()
Dim cl As Range, data As Range, lookUpRng As Range
Set data = Worksheets("Student_Travel_DB").Range("A1:A10")
Set lookUpRng = Worksheets("gokoutd").Range("A1:B10")
On Error Resume Next
For Each cl In data
cl = WorksheetFunction.VLookup(cl, lookUpRng, 2, False)
Next cl
End Sub
You'll need to change your range references.