I'm using a vlookup to pull a date from another sheet and I'm referencing a cell in the sheet that I want it to pull to. I want to drag the vlookup down but I can't figure out how to anchor the formula so it remains the same when I drag it down. Also I'm referencing cell "I2" and then I want the Vlookup then to reference "I3" and so on, but I'm not exactly sure how to code it. Any help would be appreciated! Here's my code:
Dim lastrow As Long
Dim StoreData As Range
lastrow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
Set StoreData = Sheets("List of Stores").Range("A2:C" & lastrow)
Sheets("SJ360 for Source 140").Select
Range("H1").Select
Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
On Error GoTo myerrorhandler:
Dim x
With ThisWorkbook.Worksheets("SJ360 for Source 140")
x = Application.WorksheetFunction.VLookup(Range("I2"), StoreData, 3, False)
Range("H2").Value = x
End With
Dim FillFormula As Variant
x = x + 1
With ThisWorkbook.Sheets("SJ360 for Source 140")
Range("H2").Select
ActiveCell.Offset(x, 0).Select
FillFormula = "VLookup(x), StoreData, 3, False)"
.Range("H2:H&lastrow").Formula = FillFormula
.Range("H&lastrow").FillDown
End With
myerrorhandler:
If Err.Number = 1004 Then
MsgBox "Value not found"
End If
I tried to make it so x would be "I2" then "I3" etc but I didn't do it right.
Try this. When trying to fill the same formula down a range use R1C1:
Dim lastrow As Long
Dim StoreData As Range
lastrow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
Set StoreData = Sheets("List of Stores").Range("A2:C" & lastrow)
With Sheets("SJ360 for Source 140")
.Range("H1").EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
.Range("H2:H" & lastrow).FormulaR1C1 = "Vlookup(RC1," & StoreData.Address(1, 1, xlR1C1, True) & ",2,False)"
End With
If all you want is the value in the cells then use this:
Dim lastrow As Long
Dim StoreData As Range
lastrow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
Set StoreData = Sheets("List of Stores").Range("A2:C" & lastrow)
With Sheets("SJ360 for Source 140")
.Range("H1").EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
.Range("H2:H" & lastrow).Value = .Evaluate("INDEX(Vlookup(I2:I" & lastrow & "," & StoreData.Address(1, 1,,True) & ",2,False),)")
End With
Related
I am having trouble making a string variable equal to the cell in a worksheet since I get a type mismatch. I would also like to make a single string variable (SheetString) equal to all worksheet content. A portion of my code is below:
Range("A1").Select
Set sht = ThisWorkbook.Worksheets("Sheet3")
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
Set rng = Range("A1:A" & LastRow).SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Delete
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
'MsgBox (Continue)
Set rng = Range("A1:A" & LastRow)
'For x = 1 To LastRow
'RowString = cell(x, 1).Value
'if instr(,RowString,("Sheet1").
SheetString = Range("a1:a" & LastRow).Value
MsgBox (Continue)
IE.Quit
Thanks
you can't assign a string like this, if you want to asign the whole Range in Column A, you nned a loop, like this:
For i = 1 To LastRow
SheetString = SheetString & ";" & Range("A" & i).Value
Next i
See this example
Sub Sample()
Dim SheetString As String
LastRow = 12 '<~~ Example
SheetString = range("a1:a" & LastRow).Value
End Sub
You can't do this. You can store the entire column in an array though. For that you have to declare SheetString as Variant as shown below else you will get the Type Mismatch error as you are currently getting
Sub Sample()
Dim SheetString As Variant
LastRow = 12 '<~~ Example
SheetString = range("a1:a" & LastRow).Value
End Sub
This will create an array which you can loop to access
For i = LBound(SheetString) To UBound(SheetString)
Debug.Print SheetString(i, 1)
Next i
I want to copy certain cells (for, if then condition) to an other sheet. I got great help with my code and it smoothly runs through the lines so far, but still it doesn't do exactly what I want.
I want to look for the value 848 in column A, if there is 848 in a certain row X, I want to copy the content of the following cells: XA, XN, XO, XAM, AH, XP XE and XF to the other worksheet. But: the columns do not remain the same. They change from one to the other workbook like:
Copy value in the column X in “source” --> Column Y in “target”
A --> A, N-->B, O-->C, AM -->D, AH -->G, P-->I, E-->J, F-->K
After checking and copy pasting all the needed cells of rows containing 848 in column A, we do the same for the rows containing 618 in column A.
A --> A N-->B O-->C AM -->D T -->G P-->I E-->J F-->K
As I said, the code in general works properly, it's just that I don't get the right values to the cell I want them to. Any ideas? Thanks a lot!
Sub CopyToNewBook()
On Error Resume Next
Dim wbSrc As Workbook: Set wbSrc = Workbooks("invoices_eCMS.xlsx")
Dim wbDest As Workbook: Set wbDest = Workbooks("destination.xlsx")
If wbSrc Is Nothing Or wbDest Is Nothing Then
MsgBox "Please open both workbooks required"
Exit Sub
End If
On Error GoTo 0
Dim SearchValues() As String: SearchValues = Split("848,618", ",")
Dim wsSrc As Worksheet: Set wsSrc = wbSrc.Sheets("Data exAlps")
Dim wsDest As Worksheet: Set wsDest = wbDest.Sheets("Sheet1")
Dim LastRow As Long, i As Long, j As Long, z As Long: z = 63976
With wsSrc
LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For j = 0 To UBound(SearchValues)
For i = 2 To LastRow
If .Cells(i, 1).Value = SearchValues(j) Then
.Range(.Cells(i, 1), .Cells(i, 14)).Copy
'.Cells(i, 1).Copy
wsDest.Range("A" & z).PasteSpecial xlPasteValues
z = z + 1
', .Cells(i, 14)).Copy
End If
Next i
Next j
End With
End Sub
Updated Code:
Sub CopyToNewBook()
On Error Resume Next
Dim wbSrc As Workbook: Set wbSrc = Workbooks("invoices_eCMS.xlsx")
Dim wbDest As Workbook: Set wbDest = Workbooks("destination.xlsx")
If wbSrc Is Nothing Or wbDest Is Nothing Then
MsgBox "Please open both workbooks required"
Exit Sub
End If
On Error GoTo 0
Dim SearchValues() As String: SearchValues = Split("848,618", ",")
Dim wsSrc As Worksheet: Set wsSrc = wbSrc.Sheets("Data exAlps")
Dim wsDest As Worksheet: Set wsDest = wbDest.Sheets("Sheet1")
Dim LastRow As Long, i As Long, j As Long, z As Long: z = 63976
With wsSrc
LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For j = 0 To UBound(SearchValues)
For i = 2 To LastRow
If .Cells(i, 1).Value = SearchValues(j) Then
wsDest.Range("A" & z).Value = .Range("A" & i).Value
wsDest.Range("B" & z).Value = .Range("N" & i).Value
wsDest.Range("C" & z).Value = .Range("O" & i).Value
wsDest.Range("D" & z).Value = .Range("AM" & i).Value
wsDest.Range("G" & z).Value = .Range("AH" & i).Value
wsDest.Range("I" & i).Value = .Range("P" & z).Value
wsDest.Range("J" & i).Value = .Range("E" & z).Value
wsDest.Range("K" & i).Value = .Range("F" & z).Value
z = z + 1
', .Cells(i, 14)).Copy
End If
Next i
Next j
End With
End Sub
The problem exists here:
.Range(.Cells(i, 1), .Cells(i, 14)).Copy
wsDest.Range("A" & z).PasteSpecial xlPasteValues
where are you defining a specific range to copy and specific place to paste.
Since you want to copy certain columns in one sheet to different columns in your other sheet, you'll need to specify each one separately. See my example below. I didn't do each iteration, but you can just copy the code I wrote and adjust for each:
wsDest.Range("A" & z).Value = .Range("A" & i).Value
wsDest.Range("B" & z).Value = .Range("N" & i).Value
wsDest.Range("C" & z).Value = .Range("O" & i).Value
'... and so on for each cell that needs to be copied
If it's not clear, replace the code where I stated the problem was with the code I provided as a solution.
I am trying to write a change log for excel VBA. I want it to iterate through so that the each additional response is populated in the workbook as the additional rows. Please let me know if you have any insight into what is wrong with my code
Dim streply As String
Dim Today As Date
Dim myrange As Range
Dim inglastrow As Long
CurrentDate = Date
With Sheets("Sheet1")
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
nextrow = lastrow + 1
MsgBox lastrow
MsgBox nextrow
End With
MsgBox lastrow
streply = InputBox(Prompt:="Please type description of changes", Title:="Change Log", Default:="Brief Desc.")
If streply <> " " Then
Range("A" & nextrow).Value = Application.UserName
Range("B" & nextrow).Value = streply
Range("C" & nextrow).Value = ActiveWorkbook.Name
Range("D" & nextrow).Value = Date
End If
Set lastrow = Nothing
Set nextrow = Nothing
End Sub
EDIT: silly mistake on my part, fixed now
Instead of:
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
Try:
lastrow = .UsedRange.Rows.Count
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.
I have this script that I had help with already, but now comes an issue. I am attempting to paste only the value, not the formula that is inside the cell to another cell.
I thought placing the .Value at the end of formula would tell the script to paste only the value... it seems not to be. Can someone give me a suggestion on how to make this work?
Option Explicit
Sub ONJL()
Dim lastrow As Long
Dim wsPAR As Worksheet 'PAERTO
Dim wsRD As Worksheet 'Raw Data
Dim wsTEM As Worksheet 'Archive
Set wsPAR = Sheets("PAERTO")
Set wsRD = Sheets("Raw Data")
Set wsTEM = Sheets("Template")
With wsRD
Application.ScreenUpdating = False
lastrow = .Range("J" & .Rows.Count).End(xlUp).Row
wsRD.Range("J" & lastrow + 1).Formula = Date
wsRD.Range("B2").Copy wsRD.Range("K" & lastrow + 1).Value
wsRD.Range("B3").Copy wsRD.Range("L" & lastrow + 1).Value
wsRD.Range("E2").Copy wsRD.Range("M" & lastrow + 1).Value
wsRD.Range("E3").Copy wsRD.Range("N" & lastrow + 1).Value
wsRD.Range("H2").Copy wsRD.Range("O" & lastrow + 1).Value
wsRD.Range("H3").Copy wsRD.Range("P" & lastrow + 1).Value
wsRD.Range("Q1:T1").Copy wsRD.Range("Q" & lastrow + 1)
Application.ScreenUpdating = False
End With
End Sub
You can "copy" without actually using .Copy like this:
Sub CopyWithoutCopying()
Dim wsRD As Worksheet
Dim lastrow As Long
Set wsRD = Sheets("Raw Data")
With wsRD
lastrow = .Range("J" & .Rows.Count).End(xlUp).Row
.Range("K" & lastrow + 1).Value = .Range("B2").Value
.Range("L" & lastrow + 1).Value = .Range("B3").Value
' etc...
End With
End Sub
This approach doesn't use your clipboard, performs better, and doesn't select anything. And as Jimmy points out, you don't need the wsRD prefix inside the With block.