I have the following that is placing a simple Vlookup into a cell.
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-25],[MasterFood.xlsx]Sheet1!C1:C6,6,0),0)"
I'm needing to replace the -25 with the a variable (called LastColumn) which has already been calculated as the column number will change everytime the program is run. The full part of the code is below
Dim LastColumn As Integer
If WorksheetFunction.CountA(Cells) > 0 Then
LastColumn = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Cells(1, LastColumn + 1).Select
ActiveCell.FormulaR1C1 = "ORDER"
End If
Cells(2, LastColumn + 1).Select
'Define Categories
For z = 2 To RowCount - 1
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-25],[MasterFood.xlsx]Sheet1!C1:C6,6,0),0)"
ActiveCell.Offset(1, 0).Select
Next
Any ideas please?
Here you go:
ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[" & LastColumn & "],[MasterFood.xlsx]Sheet1!C1:C6,6,0),0)"
Related
I am wondering if it is possible to replicate my code 30 times with slight variations to FIND function, finding different items "New Food Price, New Pizza Price, New Seafood Price.. Etc"
If I was to copy the whole code 34 times it would be extremely long, and if anything changed I would have to change it 34 times. Is it at all possible to repeat majority of the code 34 times and just change the FIND word & Formulas that are pasted?
Dim rng As Range
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
With Range("A1:FF1")
Set rFind = .Find(What:="US", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
LastColumn = rFind.Column
End If
End With
Set rng = Range(Cells(2, LastColumn), Cells(2, LastColumn + 7))
final_Column = Application.Match("New Food Price", rng, 0)
LastColumn = LastColumn + final_Column
Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Cells(2, LastColumn).Select
ActiveCell.Value = "New Food Price"
ActiveCell.Interior.ColorIndex = 22
Range(Cells(3, (LastColumn)), Cells(LR, (LastColumn))).Formula = "=(5)"
LastColumn = LastColumn + 1
Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Cells(2, LastColumn).Select
ActiveCell.Value = "Difference"
ActiveCell.Interior.ColorIndex = 22
Range(Cells(3, (LastColumn)), Cells(LR, (LastColumn))).Formula = "=(6)"
Set rng = Range(Cells(2, LastColumn), Cells(2, LastColumn + 7))
final_Column2 = Application.Match("New Wine Price", rng, 0)
LastColumn = LastColumn + final_Column2
Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Cells(2, LastColumn).Select
ActiveCell.Value = "New Wine Price"
ActiveCell.Interior.ColorIndex = 22
Range(Cells(3, (LastColumn)), Cells(LR, (LastColumn))).Formula = "=(5)"
LastColumn = LastColumn + 1
Columns(LastColumn).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Cells(2, LastColumn).Select
ActiveCell.Value = "Difference"
ActiveCell.Interior.ColorIndex = 22
Range(Cells(3, (LastColumn)), Cells(LR, (LastColumn))).Formula = "=(6)"
Here you go!
Sub SearchAll()
Dim SearchTerms As Variant
SearchTerms = Array("US", "UK", "BR")
For Each SearchTerm In SearchTerms
Search SearchTerm
Next
End Sub
Sub Search(SearchTerm)
Dim rng As Range
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
With Range("A1:FF1")
Set rFind = .Find(What:=SearchTerm, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rFind Is Nothing Then
LastColumn = rFind.Column
End If
End With
...
...
End Sub
And a short explanation, as requested:
The first Sub creates an array of search terms. It is then stepped through, using a For Each. For each value the Search method is called with one parameter. This parameter is then used in the Find call.
I have to apply a formula in column S (=concatenate(p1,q2,r3). This formula has to copy down until column end.
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-2],RC[-1])"
Range("S1").Select
Selection.copy
Range("S:S").Select
ActiveSheet.Paste
Application.CutCopyMode = False
You do not want the formula all the way to the bottom of column S; you only need it to the last used cell in columns P, Q and R.
dim lr as long
with worksheets("sheet1")
lr = application.max(.cells(.rows.count, "P").end(xlup).row, _
.cells(.rows.count, "Q").end(xlup).row, _
.cells(.rows.count, "R").end(xlup).row)
.range(.cells(1, "S"), .cells(lr, "S")).FormulaR1C1 = "=CONCATENATE(RC[-3], RC[-2], RC[-1])"
end with
I'm new to macro's and need to the following on 1,000+ line sheet:
I have a sheet and and i need to duplicate every other row and then modified the new rows.
to duplicate the additional row i run this macro:
Sub CopyRows()
Dim LR As Long
Dim i As Long
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = LR To 2 Step -1
Rows(i).Copy
Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown
Application.CutCopyMode = False
Next i
End Sub
There are two additional operations I need to do on every other row after the header row.
Operation 1:
In columns B and C I need to replace the text with "data for B" and "Data for C" the text is static for each replacement.
Operation 2:
I need to cut the data in Column H and paste it in column I.
Any help in doing this Macro would be appreciated.
This is in Excel 2016
My final solution thanks to #MortenAnthonsen his solution gave me what I needed to work the following out:
Sub myMaker()
Dim LR As Long
Dim i As Long
LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = LR To 2 Step -1
Rows(i).Copy
Range(Rows(i + 1), Rows(i + 1)).Insert Shift:=xlDown
Application.CutCopyMode = False
Next i
For i = 3 To Cells(2, 2).End(xlDown).Row Step 2
Cells(i, 2).Value = "B Data"
Cells(i, 3).Value = "C Data"
Range("H" & i).Select
Selection.Cut
Range("I" & i).Select
ActiveSheet.Paste
Next i
End Sub
This should do the trick
Sub operations()
Dim i As Integer
For i = 2 To Cells(2, 2).End(xlDown).Row Step 2
Cells(i, 2).Value = "data for B"
Cells(i, 3).Value = "Data for C"
Next i
Range(Range("H2"), Range("H2").End(xlDown)).Cut Destination:= _
Range(Range("H2"), Range("H2").End(xlDown)).Offset(0, 1)
End Sub
I'm trying to add new columns to the end of the data and autofill a function. Here's my code. I got an error in the autofill part. range of method class failed. Can someone have a look please? Thanks!
Sub Geocode()
'Add Lat and Long columns to the end of the report
Dim lastColumn As Long
Dim lastRow As Long
With Sheets("ReportResults 1")
lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(1, lastColumn + 1).Value = "Location"
.Cells(1, lastColumn + 2).Value = "Latitude"
.Cells(1, lastColumn + 3).Value = "Longitude"
.Cells(2, lastColumn + 1).FormulaR1C1 = _
"=RC[-17]&"", ""&RC[-16]&"", ""&RC[-15]&"" ""&RC[-14]&"", USA"""
'auto fill formula
.Range(lastColumn + 1 & "2").Select
Selection.AutoFill Destination:=Range(lastColumn + 1 & "2:" & lastColumn + 1 & lastRow)
'copay paste value
Columns(lastColumn + 1).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End Sub
These lines are going to cause a problem because they are not in a proper named range format:
.Range(lastColumn + 1 & "2").Select
Selection.AutoFill Destination:=Range(lastColumn + 1 & "2:" & lastColumn + 1 & lastRow)
Instead try this:
.Cells(2, lastColumn + 1).Select
Selection.AutoFill Destination:=Range(Cells(2, lastColumn + 1), Cells(lastRow, lastColumn + 1))
Or even better on a single line:
.Cells(2, lastColumn + 1).AutoFill Destination:=Range(Cells(2, lastColumn + 1), Cells(lastRow, lastColumn + 1))
Sub CHECKas()
Dim lastrow As Long
Dim lastcol As Long
Dim l As Integer
Dim i As Integer
Dim rname As Constants
Set rngTarg = Selection
lastrow = Sheets("report").Range("B" & Rows.Count).End(xlUp).row
lastcol = Sheets("report").Cells(2, Columns.Count).End(xlToLeft).Column
Sheets("FEBBRAIO").Select
ActiveCell.Offset(0, -3).Copy
Sheets("REPORT").Select
Cells(1, lastcol + 1).PasteSpecial xlPasteAll
Application.CutCopyMode = False
rname = Application.ActiveCell.Value
ActiveCell.Offset(1, 0).Select
For i = 2 To lastrow
ThisWorkbook.Sheets("report").Select
If Range("f2:f" & lastrow) <= Val(CStr(rname.Value)) _
And Range("g2:g" & lastrow) > Val(CStr(rname.Value)) Then
Cells(i, ActiveCell.Column).Value = "1"
Else
Cells(i, ActiveCell.Column).Value = 0
End If
Next i
End Sub
I'm new in VBA and I can't understand how to compare a constant value with each cell in a range("g2:g" & lastrow) and ("f2:f" & lastrow). The constant value is an active cell in my case. For example considering this formula: IF(AND($R$1<G2;$R$1>=f2);1;0 where R$1$ is the active cell of the last not empty column in ROW 1. I need to fill the entire column (that is activecell.column) with the output coming out form this formula.
But the I Got mismatch error in:
If Range("f2:f" & lastrow) <= Val(CStr(rname.Value)) _
And Range("g2:g" & lastrow) > Val(CStr(rname.Value)) Then
Cells(i, ActiveCell.Column).Value = "1"
Else
Cells(i, ActiveCell.Column).Value = 0
End If
I know from the previous question that this error occurs because I'm trying to comparing a single value against an array of values. How can fix this problem?
You have to use
Range("F" & i)
in your code. Same thing applies to other instances of such code.