I would like a to make a macro to run vlookup from the last row filled.
The following code is to get the last row to be filled (column J) and the last row filled (column A), the following formula is to get the last rows of this 2 columns;
Sub lookup()
'Find the last Row with data in a Column
'In this example we are finding the last row of column A (Filled) and J (to be filled)
Dim lastRowA As Long
Dim lastRowJ As Long
With ActiveSheet
lastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
lastRowJ = .Cells(.Rows.Count, "J").End(xlUp).Row
End With
MsgBox lastRowA & " " & lastRowJ
End Sub
The vlookup looks for the value in column C and look in the range in another excel file C:\LINKED[Roster_Iloilo.xlsx]ACTIVE'!$C:$E. See picture of the File
Will need help with the vlookup please.
Is this what you are trying? (Untested)
You can write your formula
"=vlookup(C40846,'C:\LINKED[Roster_Iloilo.xlsx]ACTIVE'!$C:$E,3,0)"
as
"=vlookup(C" & "40846" & ",'C:\LINKED[Roster_Iloilo.xlsx]ACTIVE'!$C:$E,3,0)"
So all you have to do is replace the last row :)
Sub Sample()
Dim ws As Worksheet
Dim lastRowA As Long
Dim sFormulaPre As String
Dim sFormulaSuff As String
Set ws = ThisWorkbook.Sheets("Sheet1")
'=vlookup(C40846,'C:\LINKED[Roster_Iloilo.xlsx]ACTIVE'!$C:$E,3,0)
sFormulaPre = "=vlookup(C"
sFormulaSuff = ",'C:\LINKED[Roster_Iloilo.xlsx]ACTIVE'!$C:$E,3,0)"
With ws
lastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
MsgBox sFormulaPre & lastRowA & sFormulaSuff
'~~> Usage
'.Cells(1, 1).Formula = sFormulaPre & lastRowA & sFormulaSuff
End With
End Sub
Related
How do I make a change in the code so that it copies only range A:AM in sheet3 till the last row in column D, instead of copying the entire row and paste it in Sheet1 (A1) one below the other?
Option Explicit
Public Sub ABC()
Dim LastRow As Long
LastRow = Sheets(3).Cells(Rows.Count, "d").End(xlUp).Row
Dim iRow As Long
For iRow = 7 To LastRow
If Application.WorksheetFunction.CountA(Sheets(3).Range("J" & iRow & ":AM" & iRow)) <> 0 Then
Sheets(3).Rows(iRow).Copy Destination:=Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
Next iRow
End Sub
Like this:
Sheets(3).Range("A" & iRow & ":AM" & iRow).Copy
or
Sheets(3).Cells(irow, "A").Resize(1, 39).Copy
or
Sheets(3).Range("A:AM").Rows(iRow).Copy
If your goal is to replace the loop with a entire range copy/paste all at once then:
Create a variable to store the last row index based off column D and then just create your dynamic range to copy accordingly
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long
lr = ws.Range("D" & ws.Rows.Count).End(xlUp).Row '<-- Find Last Row
ws.Range("A1:AM" & lr).Copy '<-- Copy
Sheets("Sheet2").Range("A1").PasteSpecial xlPasteValues '<-- Paste
I have a macro that looks for records in Column B and if there is a value in a cell within that column then the macro will add a value to Column A in the same row. My problem occurs when Column B has NO values in it whatsoever. The macro just continues running endlessly in those instances. What I am looking for is a way to say:
If Column B contains NO value then skip to the next macro.
I know this involves an IF statement of some kind I just can not figure out how to add that logic into my existing code.
My code:
Sub Update_Column_Based_On_Column_Value_1()
On Error Resume Next
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW VALUE GOES HERE"", TEXT(,))"
.Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
End With
End Sub
My search for the answer yielded this string of code from another StackOverflow question:
If WorksheetFunction.CountBlank(emailRng) = emailRng.Cells.Count Then Exit Sub 'No data
When I added that to my code it simply ended the sub if there were ANY blank cells in a column.
Thanks in advance for the assistance! I do apologize if my question is overly noobish.
Try this:
Sub Update_Column_Based_On_Column_Value_1()
On Error Resume Next
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
' This will count all non-blanks in Column B, I put equal to 1
' because I am assuming B1 is a header with a title so it will at minimum be 1
If WorksheetFunction.CountA(ws.Range("B:B")) = 1 Then
' if count is equal to 1 then this part will run
' so enter name of the sub() or write new code in here
Else
' if not less than or equal, meaning greater than 1
' then the following code below will run
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=If(LEN(RC2),""NEW VALUE GOES HERE"", TEXT(,))"
.Range("A1:A" & lRow).Value = .Range("A1:A" & lRow).Value
End With
End If
This code will do what you want
Sub test()
Dim i As Long
Dim lRow As Long
lRow = Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To lRow
If Cells(i, "B").Value <> vbNullString Then
Cells(i, "A").Value = Cells(i, "B").Value
End If
Next i
End Sub
I have 3 columns, with headers A B & C as shown at the picture, and I want to check if the value in column A is equal to 10% of column B, if yes, I want to set it to be the value for column C, if not, I want to get 10% of values in column B. I am in sheet1 and I want to set a VBA button in sheet2 to run the codes.
Here is the code:
Sub Macro1()
Dim ws As Worksheet, lastrow As Long
Set ws = Worksheets("sheet1")
ws.Activate
ActiveCell.Formula = "=IF(A2=B2*0.1, A2, B2*0.1)"
lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range("C2").AutoFill Destination:=Range("C2:C" & lastrow), Type:=xlFillDefault
End Sub
My issues is if I point my mouse at C2 in sheet1 and I just run the vba codes, it will work. If I am at sheet2 and pressing the button, it won't work, it just doesn't show any data. Is there a way to set values to column C based on my criteria?
To make the code working on sheet1 independently of active sheet is, you need to apply .Range method exactly to Worksheets("sheet1") object. Try the below code:
Sub Macro1()
Dim lastrow As Long
With Worksheets("sheet1")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row
If lastrow = 1 Then
MsgBox "No data"
Exit Sub
End If
.Range("C2:C" & lastrow).Formula = "=IF(A2=B2*0.1, A2, B2*0.1)"
End With
End Sub
Why not to be more straightforward: always set the value to column C equal to 10% of column B? The result will be the same.
Sub Macro1()
Dim lastrow As Long
With Worksheets("sheet1")
lastrow = .Range("A" & Rows.Count).End(xlUp).Row
If lastrow = 1 Then
MsgBox "No data"
Exit Sub
End If
.Range("C2:C" & lastrow).Formula = "=B2*0.1"
End With
End Sub
I don't even know where to start so I don't have any example code. I am thinking that I need a nested loop but that is what throws me off. I look forward to learning from everyone.
Here is what I'd like to do:
Begin with the worksheet named "John" and loop through each worksheet to the right.
On each worksheet, if a cell in column L is not blank, copy cell F and cell L for that row.
Append all of the copied cells to the worksheet "Notes". Paste the data from F on each sheet to column A and paste the corresponding data from L in column B. Add the copied data from each worksheet to the end of the data in "Notes".
I really appreciate any help, thanks!!
UPDATE
Based on Alter's great help and suggestions, this is what I have and it works perfectly. Thanks Alter!
Sub test()
Dim ws As Worksheet
Dim notes_ws As Worksheet
Dim row
Dim lastrow
Dim notes_nextrow
'find the worksheet called notes
For Each ws In Worksheets
If ws.Name = "Notes" Then
Set notes_ws = ws
End If
Next ws
'get the nextrow to print to
notes_nextrow = notes_ws.Range("A" & Rows.Count).End(xlUp).row + 1
'loop through other worksheets
For Each ws In Worksheets
'ignore the notes worksheet
If ws.Name <> "Notes" And ws.Index > Sheets("John").Index Then
'find lastrow
lastrow = ws.Range("L" & Rows.Count).End(xlUp).row
For row = 1 To lastrow
'if the cell is not empty
If IsEmpty(ws.Range("L" & row)) = False Then
notes_ws.Range("A" & notes_nextrow).Value = ws.Range("F" & row).Value
notes_ws.Range("B" & notes_nextrow).Value = ws.Range("L" & row).Value
notes_nextrow = notes_nextrow + 1
End If
Next row
End If
Next ws
End Sub
Nested loop indeed, you can use the code below as a basis for what you want to do
Public Sub test()
Dim ws As Worksheet
Dim notes_ws As Worksheet
Dim row
Dim lastrow
Dim notes_nextrow
'find the worksheet called notes
For Each ws In Worksheets
If ws.name = "Notes" Then
Set notes_ws = ws
End If
Next ws
'get the nextrow to print to
notes_nextrow = notes_ws.Range("A" & Rows.Count).End(xlUp).row + 1
'loop through other worksheets
For Each ws In Worksheets
'ignore the notes worksheet
If ws.name <> "Notes" Then
'find lastrow
lastrow = ws.Range("L" & Rows.Count).End(xlUp).row
For row = 1 To lastrow
'if the cell is not empty
If IsEmpty(ws.Range("L" & row)) = False Then
notes_ws.Range("A" & notes_nextrow).Value = ws.Range("L" & row).Value
notes_nextrow = notes_nextrow + 1
End If
Next row
End If
Next ws
End Sub
I am writing a macro that copies a value from one excel worksheet, and pastes it into another. As seen below, I have a code that correctly copies and pastes my value into the correct worksheet, but I want it to paste into the next empty cell in row 3, instead of just cell "C3". All help is appreciated.
Private Sub CommandButton1_Click()
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long
Dim vMax As Variant
Set wsMaster = ThisWorkbook.Sheets("Contract Metrics")
NextRow = wsMaster.Range("A" & Rows.Count).End(xlUp).Row + 1
Set wbDATA = Workbooks.Open("C:\Documents and Settings\Michael Palkovitz\My Documents\Test\Contracts Metrics.xlsx")
With wbDATA.Sheets("Contract Task Summary(1)")
LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
If LastRow > 1 Then
.Range("C" & LastRow).Copy
wsMaster.Range("C" & 3).PasteSpecial xlPasteValues
wsMaster.Range("C" & 3).PasteSpecial xlPasteFormats
End If
End With
wbDATA.Close False
End Sub
This is the code you are looking for:
Private Sub CommandButton1_Click()
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long
Dim vMax As Variant
Dim columnToPaste As Integer
Dim lastColumnToPaste As Integer
Dim lastColumn as Integer
Set wsMaster = ThisWorkbook.Sheets("Contract Metrics")
NextRow = wsMaster.Range("A" & Rows.Count).End(xlUp).Row + 1
Set wbDATA = Workbooks.Open("C:\Documents and Settings\Michael Palkovitz\My Documents\Test\Contracts Metrics.xlsx")
With wbDATA.Sheets("Contract Task Summary(1)")
LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
If LastRow > 1 Then
.Range("C" & LastRow).Copy
lastColumn = 3
lastColumnToPaste = lastColumn + 20
columnToPaste = lastColumn - 1
Do
columnToPaste = columnToPaste + 1
If IsEmpty(wsMaster.Cells(lastRow, columnToPaste)) Then
wsMaster.Cells(lastRow, columnToPaste).PasteSpecial xlPasteValues
wsMaster.Cells(lastRow, columnToPaste).PasteSpecial xlPasteFormats
Exit Do
End If
Loop While (columnToPaste < lastColumnToPaste)
End If
End With
wbDATA.Close False
End Sub
This is just a basic approach to how the problem should be solved. You should update some values dynamically (e.g., maximum row to check, given by the variable lastRowToPaste).
Note that writing/pasting between two different workbooks is very inefficient. In case of having to repeat this process for a long enough time, I would: open the input spreadsheet and store all the values in a temporary location (depending upon the size, in an array or in a temporary file), close it; open the destination spreadsheet and write the data from this location (without relying on copy/paste). This is a much faster approach to the problem.