I want to use a VBA Function to insert a formulas into cells based on two conditions.
The conditions are (1) there has to be something in the Description (Column D on my spreadsheet) and (2) the cell I'm pasting the code into has to be blank.
The best way I can see of doing this is with a loop, but I can't figure out how to update the references in my formulas to take account of the new position.
The code below works, but it does not check to see if the cells are empty first.
Range("B8").Formula = "=IF(D8="""","""",IF(ISERROR(VLOOKUP(Trim(D8),Sheet3!$B$8:$M$7500,2,FALSE)),"""",VLOOKUP(Trim(D8),Sheet3!$B$8:$M$7500,2,FALSE)))"
Range("B8").Select
Selection.AutoFill Destination:=Range("B8:B" & Total), Type:=x1filldefault
'Adds the above formula into the range B8 to B(the last cell in use)
Range("C8").Formula = "=IF(D8="""","""",IF(ISERROR(VLOOKUP(Trim(D8),Sheet3!$B$8:$M$7500,3,FALSE)),"""",VLOOKUP(Trim(D8),Sheet3!$B$8:$M$7500,3,FALSE)))"
Range("C8").Select
Selection.AutoFill Destination:=Range("C8:C" & Total), Type:=x1filldefault
'Adds the above formula into the range C8 to C(the last cell in use)
Range("E8").Formula = "=IF(D8="""","""",IF(ISERROR(VLOOKUP(Trim(D8),Sheet3!$B$8:$M$7500,4,FALSE)),"""",VLOOKUP(Trim(D8),Sheet3!$B$8:$M$7500,4,FALSE)))"
Range("E8").Select
Selection.AutoFill Destination:=Range("E8:E" & Total), Type:=x1filldefault
'Adds the above formula into the range E8 to E(the last cell in use)
Range("J8").Formula = "=IF(D8="""","""",IF(ISERROR(VLOOKUP(Trim(D8),Sheet3!$B$8:$M$7500,9,FALSE)),"""",VLOOKUP(Trim(D8),Sheet3!$B$8:$M$7500,9,FALSE)))"
Range("J8").Select
Selection.AutoFill Destination:=Range("J8:J" & Total), Type:=x1filldefault
'Adds the above formula into the range J8 to J(the last cell in use)
Range("A8").Formula = "=If(B8="""","""",Row(A8))"
Range("A8").Select
Untested, but this should do what you want.
In a loop:
For i = 8 to Total
If cells(i, 4) <> "" Then
AddFormulaIfNotBlank cells(i, 2), _
"=IF(D<r>="""","""",IF(ISERROR(VLOOKUP(Trim(D<r>),Sheet3!$B$8:$M$7500,2,FALSE))" _
& ","""",VLOOKUP(Trim(D<r>),Sheet3!$B$8:$M$7500,2,FALSE)))"
'add rest of formulas here....
Next i
Next i
Helper Sub: populate only empty cells, and adjust the formula for the current row
Sub AddFormulaIfNotBlank(c As Range, f As String)
If Len(c.value)=0 Then
c.formula = Replace(f, "<r>", c.Row)
End If
End sub
I've tested this briefly. it assumes that the currently selected cell is at the top of the column you want to work down through before you start the procedure. Also there isn't any error handling
Sub CopyFormulas()
Dim xlRange As Range
Dim xlCell As Range
Dim xlAddress As String
xlAddress = ActiveCell.Address & ":$" & Mid(ActiveCell.Address, 2, InStr(1, ActiveCell.Address, "$")) & Mid(Cells.SpecialCells(xlCellTypeLastCell).Address, InStrRev(Cells.SpecialCells(xlCellTypeLastCell).Address, "$"), Len(Cells.SpecialCells(xlCellTypeLastCell).Address))
Set xlRange = Range(ActiveCell, xlAddress)
For Each xlCell In xlRange
xlAddress = "D" & Mid(xlCell.Address, InStrRev(xlCell.Address, "$"), Len(xlCell.Address))
If xlCell.Value = "" And Range(xlAddress).Value <> "" Then
xlCell.Value = "=IF(D8="""","""",IF(ISERROR(VLOOKUP(Trim(D8),Sheet3!$B$8:$M$7500,2,FALSE)),"""",VLOOKUP(Trim(D8),Sheet3!$B$8:$M$7500,2,FALSE)))"
End If
Next xlCell
End Sub
Related
I am trying to fill multiple columns in a sheet with vlookups from another sheet named "Go Live Data" in the same workbook, to the end of the range.
So, based off of the value starting in A6 in my sheet, I want to lookup to range A:K in sheet "Go Live Data" for cells starting in U6 to the end of the data filled in the tab (this will change dynamically). I want to repeat this for cells starting with V6 and W6.
This is the code that I have now, but it does not populate.
Sub VlookupGoLiveandBOP()
Dim Rng As Range, Dn As Range
Set Rng = Range(Range("A6"), Range("A" & Rows.Count).End(xlUp))
With Range("U6")
.Formula = "=IF(ISNA(VLOOKUP(A6,Go Live
Data!$A:$K,2,FALSE)),"""",VLOOKUP(A6,Go Live Data!$A:$K,2,FALSE))"
.AutoFill Destination:=Rng.Offset(, 66)
With Range("v6")
.Formula = "=IF(ISNA(VLOOKUP(A6,Go Live
Data!$A:$K,3,FALSE)),"""",VLOOKUP(A6,Go Live Data!$A:$K,3,FALSE))"
.AutoFill Destination:=Rng.Offset(, 66)
With Range("w6")
.Formula = "=IF(ISNA(VLOOKUP(A6,Go Live
Data!$A:$K,4,FALSE)),"""",VLOOKUP(A6,Go Live Data!$A:$K,4,FALSE))"
.AutoFill Destination:=Rng.Offset(, 66)
End With
Rng.Offset(, 66).Value = Rng.Offset(, 66).Value
End Sub
Am I on the wrong track? Thank you for your help.
Try the code below, it will help you assign the VLookup range correctly.
When using LKUpRng.Address(True, True, xlA1, xlExternal) the 4th parameter xlExternal adds also the sheet's name (and workbook if needed) with all the ' and ! needed.
Code
Option Explicit
Sub VlookupGoLiveandBOP()
Dim Rng As Range, Dn As Range
Dim LKUpRng As Range
Dim LkUpStr As String
Set LKUpRng = Sheets("Go Live Data").Range("A:K")
LkUpStr = LKUpRng.Address(True, True, xlA1, xlExternal) '<-- get the Range as a String, including the sheet's name
Set Rng = Range(Range("A6"), Range("A" & Rows.Count).End(xlUp))
Range("U6").Formula = "=IF(ISNA(VLOOKUP(A6," & LkUpStr & ",2,FALSE)),"""",VLOOKUP(A6," & LkUpStr & ",2,FALSE))"
End Sub
I'm running into trouble highlighting a column's used range. The following code creates copies of two worksheets, removes some values and then is supposed to highlight certain columns.
Sub CreateAnalysisSheets()
Dim cell, HlghtRng As Range
Dim i As Integer
Dim ref, findLast, findThis As String
Dim lastRow As Long
findLast = "2016"
findThis = "2017"
Application.ScreenUpdating = False
Sheets(1).Copy After:=Sheets(2)
ActiveSheet.Name = Left(Sheets(1).Name, InStr(1, Sheets(1).Name, " ")) & "Analysis"
Sheets(2).Copy After:=Sheets(3)
ActiveSheet.Name = Left(Sheets(2).Name, InStr(1, Sheets(2).Name, " ")) & "Analysis"
Sheets("RM Analysis").Select
For Each cell In ActiveSheet.UsedRange
If cell.Value = "NULL" Then
cell.ClearContents
End If
Next cell
For Each cell In Range("1:1")
ref = cell.Value
lastRow = Range("R" & Rows.Count & "C" & cell.Column).End(xlUp).Row
Set HlghtRng = Range(Cells(1, cell.Column) & Cells(lastRow, cell.Column))
If InStr(1, ref, findLast) > 0 And InStr(1, ref, "YTD") = 0 Then
HlghtRng.Interior.ColorIndex = 8
End If
Next cell
For Each cell In Sheets(4).UsedRange
If cell.Value = "NULL" Then
cell.ClearContents
End If
Next cell
Sheets("RM Analysis").Select
Application.ScreenUpdating = True
End Sub
The problem comes at lastRow = Range("R" & Rows.Count & "C" & cell.Column).End(xlUp).Row where I get an Method 'Range' of Object '_Global' Failed. I've tried searching for ways to fix this issue, but everything I've tried (ActiveSheet.Range and Sheets("RM Analysis").Range) has yet to work.
Anyone see where I'm going wrong here?
The xlR1C1 syntax is fouling up your request for the last non-blank cell.
lastRow = Cells(Rows.Count, cell.Column).End(xlUp).Row
I would highly recommend that you avoid relying on the ActiveSheet and use explicit parent worksheet references. This can be made quite simple using With ... End With and preceding all Range and Cells with a . like .Range(...) or .Cells(...).
Once you within a With ... End With statement, all of the references need to be prefaced with a .. Additionally, the following is not a string concatenation (e.g. &) but as .Range(starting cell comma ending cell) operation.
with worksheets("RM Analysis")
...
Set HlghtRng = .Range(.Cells(1, cell.Column), .Cells(lastRow, cell.Column))
...
end with
this should do
Columns(1).Interior.ColorIndex = 3
change the number of column as to the column you wanna highlit
The purpose of this macro is copy one cell value (from a long list) to another cell located in a different sheet.
here's my code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G2:G1048576")
For Each cell In Rng
'test if cell is empty
If cell.Value <> "" Then
finaljnl.Range("L4").Value = rawben.Range("G5").Value
finaljnl.Range("K4").Value = rawben.Range("L5").Value
End If
Next
End Sub
With the help of the image, I will explain what I'm trying to achieve:
From Sheet1 ("BEN") there's a list sitting in columns G and L.
I will copy the cell G5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range K4.
Next is I will copy the cell L5 from Sheet1 and paste it in Sheet2 ("JNL_BEN") Range L4.
Copy the next in line and do the same process just like No.2 and 3 but this time, it will adjust 1 row below.
Copy the whole list. That means up to the bottom. The list is dynamic, sometimes it will go for 5,000 rows.
For some reasons, copying the entire column is not an option to this macro due to requirement that cells from sheet1 MUST be pasted or placed in Sheet2 from left to right (or horizontally).
I hope you could spare some time to help me. My code didn't work, I guess the implementation of FOR EACH is not correct. I'm not sure if FOR EACH is the best code to use.
I appreciate anyone's help on this. Thank you very much! May the force be with you.
Try this:
Sub journalben()
Dim i As Long, lastRow As Long
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
lastRow = rawben.Cells(Rows.Count, "G").End(xlUp).Row
For i = 5 To lastRow
'test if cell is empty
If rawben.Range("G" & i).Value <> "" Then
finaljnl.Range("K" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("L" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
I am starting FOR from 5 as the data in your image starts from cell G5 (not considering the header).
It'll be easier to use a numeric variable for this :
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = rawben.Range("G4:G1048576")
For i = Rng.Cells(1,1).Row to Rng.Cells(1,1).End(xlDown).Row
'test if cell is empty
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & i - 1).Value = rawben.Range("G" & i).Value
finaljnl.Range("K" & i - 1).Value = rawben.Range("L" & i).Value
End If
Next i
End Sub
You should use a simple for loop. It is easier to work with.
Also, to have it dynamic and to go to the last cell in the range, use the SpecialCells method.
And your range needs to be set correctly from row 5.
Here is the code:
Sub journalben()
Set rawben = Sheets("BEN")
Set finaljnl = Sheets("JNL_BEN")
Set Rng = Range("G5:G1048576")
For i = Rng.Cells(1,1).Row to Rng.SpecialCells(xlCellTypeLastCell).Row
If rawben.Range("G" & i).Value <> vbNullString Then
finaljnl.Range("L" & CStr(i - 1)).Value = rawben.Range("G" & CStr(i)).Value
finaljnl.Range("K" & CStr(i - 1)).Value = rawben.Range("L" & CStr(i)).Value
End If
Next i
End Sub
I have two worksheets (sheet1 and sheet2). Both contain a column with header "ID" (columns are not always in the same position so need to be found).
Needed is a vlookup in a new column before the "ID" column.
This is what I got so far
sub vlookup ()
FIND COLUMNS WITH "ID"-HEADER
'Set variables for Column Sku
'note: cfind1 is for sheet 1 and cfind 2 is for sheet 2
Dim col As String, cfind1 As Range, cfind2 As Range
column = "ID"
Worksheets(1).Activate
Set cfind1 = Cells.Find(what:=column, lookat:=xlWhole)
Worksheets(2).Activate
Set cfind2 = Cells.Find(what:=column, lookat:=xlWhole)
'CREATE COLUMN WITH VLOOKUP
'activate worksheet 1
Worksheets(1).Activate
'add column before sku-column
cfind1.EntireColumn.Insert
'Select cell 1 down and 1 to left of sku-cell.
cfind1.Offset(1, -1).Select
'Add VlookUp formulas in active cell
ActiveCell.Formula = "=VLOOKUP(LookUpValue, TableArray,1,0)"
'(Lookup_Value should refer to one cell to the right
(= cfind1.Offset (1, 0)??)
'Table_Array should refer to the column in sheet(2) with header "id"
'Autofill Formula in entire column
'???
End Sub
Everything is working fine until the "vlookup-part"
I managed to put a formula in the correct cell, but I just can't get the formula to work.
How can I set lookup_value as "one cell to the right" in the same sheet
and "table_array" as the column with header "ID" in worksheet(2)?
And how can I finally autofill the vlookup formula throughout the whole column?
It would be great if anybody can help me out with the correct vlookup formula / variables and the autofilling.
You could also use something similar to below should you want to avoid using the worksheet
curr_stn = Application.WorksheetFunction.VLookup(curr_ref, Sheets("Word_Specifications").Range("N:O"), 2, False)
Valuse/variables will need to be changed of course. lookup_value,Array (range), Column number, Exact match.
Exact match needs false and similar match needs true
Try below full code
Sub t()
Dim col As String, cfind1 As Range, cfind2 As Range
Column = "ID"
Worksheets(1).Activate
Set cfind1 = Cells.Find(what:=Column, lookat:=xlWhole)
Worksheets(2).Activate
Set cfind2 = Cells.Find(what:=Column, lookat:=xlWhole)
'CREATE COLUMN WITH VLOOKUP
'activate worksheet 1
Worksheets(1).Activate
'add column before sku-column
cfind1.EntireColumn.Insert
'Select cell 1 down and 1 to left of sku-cell.
cfind1.Offset(1, -1).Select
'Add VlookUp formulas in active cell
LookUp_Value = cfind1.Offset(1, 0).Address(False, False)
Table_Array = Col_Letter(Worksheets(2).Cells.Find(what:=Column, lookat:=xlWhole).Column) & ":" & Col_Letter(Worksheets(2).Cells.Find(what:=Column, lookat:=xlWhole).Column)
ws_name = Worksheets(2).Name
Col_index_num = 1
Range_Lookup = False
ActiveCell.Formula = "=VLOOKUP(" & LookUp_Value & ", " & ws_name & "!" & Table_Array & ", " & Col_index_num & ", " & Range_Lookup & ")"
'Autofill Formula in entire column
lastrow = Range(cfind1.Address).End(xlDown).Row
Range(cfind1.Offset(1, -1).Address).AutoFill Destination:=Range(cfind1.Offset(1, -1).Address & ":" & Col_Letter(cfind1.Offset(1, -1).Column) & lastrow), Type:=xlFillDefault
End Sub
Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function
Haven't done this before but my approach would be to use the cell or range.formula property and build the string that you would write in the cell. for example:
myrange.formula = "=Vlookup("&Lookup_Value&","&Table_Array&","&Col_index_num&","&Range_Lookup&")"
I wonder if you can help me with this:
Ranges B11:B251 & C11:C251 may or may not have some values.
I want to be able to copy non blank cells from cell ranges M11:M251 & N11:N251 to B11:B251 & C11:C251, so if there are any values in M&N ranges they should overwrite values in the same rows in B&C but if there are blank values in M&N ranges they should not be copied and leave the values already present (or not) in B&C.
Was I clear? ;-)
Thanks for any replies!
Sub Main()
Dim i As Long
For i = 11 To 251
If Not IsEmpty(Range("M" & i)) Then _
Range("B" & i) = Range("M" & i)
If Not IsEmpty(Range("N" & i)) Then _
Range("C" & i) = Range("N" & i)
Next i
End Sub
this code will only copy non empty values from M&N columns to B&C
This piece of code should do the trick:
Sub CopyRangeToRange()
Dim CpyFrom As Range
Dim Cell As Range
Set CpyFrom = ActiveSheet.Range("M11:N251")
For Each Cell In CpyFrom
If Cell.Value <> vbNullString Then
Cell.Offset(0, -11).Value = Cell.Value
End If
Next Cell
End Sub