I have value in Sheet1 "B" column which is to be vlookup in Sheet2 from Column "A to K" and copy the corresponding C column value of Sheet2 and paste it in Sheet1's E column.
I have tried with below code but it shows error as
Run-time error '1004':
Unable to get the Vlookup Property of the worksheetfunction class.
Sub vlook_up()
For i = 2 To 11
Cells("D" & i).Value = WorksheetFunction.VLookup(Sheets("Sheet1").Range("B" & i), Sheets("Sheet2").Range("A1:K500"), 3, 0)
Next i
End Sub
This works for me, however I feel you are passing the function an inappropriate var type.
Sub vlook_up()
For i = 2 To 11
Range("D" & i).Value = WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(Sheets("Sheet1").Range("B" & i), Sheets("Sheet2").Range("A1:K500"), 3, False), "error")
Next i
End Sub
Try with this
Sub vlook_up()
For i = 2 To 11
Range("D" & i).Value = Application.WorksheetFunction.VLookup(Sheets("Sheet1").Range("B" & i), Sheets("Sheet2").Range("A1:K500"), 3, False);
Next i
End Sub
or
Sub vlook_up()
For i = 2 To 11
Range("D" & i).Value = Application.VLookup(Sheets("Sheet1").Range("B" & i), Sheets("Sheet2").Range("A1:K500"), 3, False);
Next i
End Sub
Related
I've been strugling to color alternate rows in a range in VBA. The problem is that the Range method seems not to select the proper range and I end up coloring adjacent cells. This is my desired output:
But, this is what I actually get:
This is the code I created:
Sub limpar_aniversariantes()
Worksheets("Aniversariantes").Range("B4:D900").ClearContents
'Worksheets("Aniversariantes").Range("B4:D900").Interior.Color = RGB(255, 255, 255)
End Sub
Sub gerar_lista_aniversariantes()
limpar_aniversariantes
Dim newrange As Range, rw As Range
Sheets("Base de Alunos").Select
Set newrange = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
CountInicioMes = 12
CountInicio = 16
Count = CountInicio
count_first_line = 0
For Each rw In newrange.Rows
Worksheets("Aniversariantes").Range("B" & Count).Value = rw.Cells(2).Value
Worksheets("Aniversariantes").Range("C" & Count).Value = Left(rw.Cells(5).Value, 2)
Worksheets("Aniversariantes").Range("C" & Count).NumberFormat = "DD"
Worksheets("Aniversariantes").Range("D" & Count).Value = UCase(rw.Cells(15).Value)
'Worksheets("Aniversariantes").Range("A" & Count).Value = Count
'pintar linhas alternadamente de cinza
If Count Mod 2 = 0 Then
Worksheets("Aniversariantes").Range("B" & Count & ":D" & Count).Interior.Color = RGB(211, 211, 211)
Debug.Print ("B" & Count & ":D" & Count)
End If
'pegar mes dos aniversariantes, eh preciso pular header
If count_first_line < 2 Then
count_first_line = count_first_line + 1
If count_first_line = 2 Then
my_date = rw.Cells(5).Value
End If
End If
'Debug.Print Left(rw.Cells(5).Value, 2)
Count = Count + 1
'Debug.Print rw.Cells(2).Value
Next rw
Worksheets("Aniversariantes").Range("B" & (CountInicio + 1) & ":D" & Count).Sort key1:=Worksheets("Aniversariantes").Range("C" & (CountInicio + 1) & ":C" & Count), _
Header:=xlNo
'limpar bordas anteriores
Worksheets("Aniversariantes").Columns("B:D").Borders.LineStyle = xlNone
Worksheets("Aniversariantes").Range("B" & (CountInicio) & ":D" & (Count - 1)).Borders.LineStyle = xlContinuous
'.Weight = xlThin.ColorIndex = 3
my_month = Mid(my_date, 4, 2)
my_month_written = RetornarMes(CInt(my_month))
Worksheets("Aniversariantes").Range("B" & CountInicioMes).Value = UCase(my_month_written)
Worksheets("Aniversariantes").Range("B" & CountInicio).Value = "NOME"
Worksheets("Aniversariantes").Range("C" & CountInicio).Value = "DIA"
Worksheets("Aniversariantes").Range("D" & CountInicio).Value = "MODALIDADE"
'mudar cor de fundo
'Worksheets("Aniversariantes").Range("B" & CountInicio & ":D" & CountInicio).Interior.Color = RGB(255, 255, 0)
'Debug.Print my_month_written
End Sub
I am coping values from one worksheet to another and I am using MOD function to only color even lines. Everytime I copy these values the number of lines can change, that's why I need to do it by VBA. I am not mastered in VBA so any help is appreciated. I have struggled to do it the whole morning.
Edit: I notticed that choosing a row out of the PERSON's data table makes the Range().Interior.Color function works properly, the problem is inside the range.
All right,
Thanks to #Thomas Inzina comment, I realized that the formula "=MOD(ROW(),2)<>0" should be translated to my native excel language, e.i: Portuguese. Then the right translation is "=MOD(LIN();2)<>0". But, still I did not figure out why I was getting that weird behaviour that I showed in my question, instead I used this solution (with the proper formula) to solve my issue:
https://stackoverflow.com/a/15957075/1171721
I am satisfied with that since I got what I wanted, but still if anyone discovers why I got this strange behaviour using the old approach, I will be happy to test the proposed solution for the sake of learning.
I'm trying to copy some data from one Sheet to another using a vba script, it works fine but it doesn't appear to gather all the results, the data i have is split up over multiple tables so i assume it's seeing a blank space and stepping out but i'm not sure the solution! (the results i'm after are all letters i.e A-f and are all located on column C)
code below:
Sub copytoprint()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Application.ScreenUpdating = False
On Error GoTo Err_Execute
LSearchRow = 2
LCopyToRow = 2
While Len(Range("C" & CStr(LSearchRow)).value) > 0
If InStr(1, Range("C" & CStr(LSearchRow)).value, "A") > 0 Then
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
Sheets("dest").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste
LCopyToRow = LCopyToRow + 1
Sheets("source").Select
End If
LSearchRow = LSearchRow + 1
Wend
Application.CutCopyMode = False
Range("A3").Select
MsgBox "All matching data has been copied."
Exit Sub
Err_Execute:
MsgBox "An error occurred."
End Sub
Input would just be a basic line of details i.e
ID person ref itemid itemname shape
Alphas1 bob A As01 Alphaselects1 circle
Alphas2 Stuart B As02 Alphaselects2 circle
Basically they are split up with many records I'd like it to grab all the A reference put them in one table then folow on with B C etc
Hope that makes a little sense?
Looks like you want to search from ActiveSheet using certain reference (A,B,C,,etc) and copy matching rows into unique destination sheets.
Below code will help you accomplish this, it separates the copying sub-procedure out into its own sub (called copyToSheet) and you can keep calling it from copytoprint() each time giving a reference and the destination sheet you desire.
Option Explicit
Private Sub copyToSheet(reference As String, shtSource As Worksheet, shtDest As Worksheet)
Dim x As Integer
Dim y As Integer
shtDest.Range("A2:Z" & shtDest.UsedRange.Rows.Count + 2).ClearContents
x = 2
y = 2
'loop until 20 consequtive rows have column C blank
While (Not shtSource.Range("C" & x).Value = "") _
And (Not shtSource.Range("C" & (x + 1)).Value = "") _
And (Not shtSource.Range("C" & (x + 5)).Value = "") _
And (Not shtSource.Range("C" & (x + 10)).Value = "") _
And (Not shtSource.Range("C" & (x + 20)).Value = "")
'If shtSource.Range("C" & x).Value, reference) > 0 Then
If shtSource.Range("C" & x).Value = reference Then
shtDest.Range("A" & y & ":Z" & y).Value = shtSource.Range("A" & x & ":Z" & x).Value
y = y + 1
End If
x = x + 1
Wend
End Sub
Public Sub copytoprint()
copyToSheet "A", ActiveSheet, Sheets("A")
copyToSheet "B", ActiveSheet, Sheets("B")
MsgBox "All matching data has been copied."
End Sub
So if I understood your problem correctly then you want to sort the data in sheet source first and then paste all of that data in another sheet.
If that's the case try this code.
Sub copytoprint()
Dim lastrow As Double
With Sheets("source")
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("A2:F" & lastrow).Sort key1:=Range("C3:C" & lastrow), order1:=xlAscending, Header:=xlNo
End With
Sheets("dest").Range("A2:F" & lastrow).Value = Sheets("source").Range("A2:F" & lastrow).Value
End Sub
I am trying to loop the value for column E so that I can use it to VLookup on another worksheet and return the value to column F.
It has been giving me the error
of Application-defined or object-defined error
on the line:
result = Application.WorksheetFunction.VLookup(look, Sheet2.Range("B:H"), 2,
False)
My Code
Dim X As Integer
Dim look As Variant
Dim result As Variant
X = 2
Sheet3.Range("E2").Select
Do Until IsEmpty(ActiveCell)
look = Sheet3.Cells(X, 5).Value
ActiveCell.Offset(1, 0).Select
result = Application.WorksheetFunction.VLookup(look, Sheet2.Range("B:H"), 2, False)
Sheet3.Cells(X, 6).Value = result
X = X + 1
Loop
Try the code below (without using Select, and ActiveCell) :
Option Explicit
Sub VLookupHandleNA()
Dim X As Long
Dim Look As Variant
Dim Result As Variant
X = 2
With Sheet3
Do Until IsEmpty(.Range("E" & X).Value)
Look = .Range("E" & X).Value
Result = Application.VLookup(Look, Sheet2.Range("B:H"), 2, False)
If Not IsError(Result) Then
.Range("F" & X).Value = Result
Else ' if Vlookup returns an error, just write something in the cell to let the user know
.Range("F" & X).Value = "VLookup wasn't able to find " & Look
End If
X = X + 1
Loop
End With
End Sub
I just can't work around this particular problem of mine where I have to concatenate all cells with data to a string, (e.g. " or ') in one column and then generate that concatenated result in another column.
Expected result:
Column A = ABCD
Column B = 'ABCD',
My Code
Option Explicit
Sub Concatenator ()
Columns("B") = "'" & Range(Range("A1"), Range("A1").End(xlDown)) & "',"
End Sub
I would put the code in a FOR Loop:
Sub Concatenator()
Dim lastLng As Long
lastLng = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
For x = 1 To lastLng
Cells(x, 2).Value = "'" & Cells(x, 1).Value & "',"
Next x
End Sub
Alternatively, if you don't want to use a loop, you can use the code below to paste your formula in column B:
Sub Concatenator()
Dim lastLng As Long
lastLng = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
Range("B1:B" & lastLng).Formula = "=""'"" & A1 & "",'"""
End Sub
or you could use this
Sub Concatenator()
Range("A1", Cells(Rows.count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues).Offset(, 1).Formula = "=concatenate(""'"",RC[-1],""'"")"
End Sub
or this:
Sub Concatenator()
With Range("A1", Cells(Rows.count, 1).End(xlUp))
.Offset(, 1).Value = Application.Transpose(Split(Replace("'" & Join(Application.Transpose(.Value), "'|''") & "'", "'''", "''"), "|"))
End With
End Sub
I am trying to run a code to validate a column "K". If any cells in column "K" is Null then an error message should pop up and the cell should turn to red. I tried the following code and it is working. Following is my issue.
I run the macro.
Macro detects the Null cell and pop up error msg.
I deleted the row with Null cell.
Run macro again.
Error msg pop up again. Last cell of column K turn into red eventhough that row doesnt have any data.
This is the code I am using
Sub Errormsg ()
count2 = Range("B:B").SpecialCells(xlLastCell).Row
For n = 2 To count2
If Range("K" & n).Value = vbNullString Then
Range("K" & n).Interior.ColorIndex = 3
MsgBox "Error ! Null value "
Exit Sub
End If
Next n
End Sub
Use another column (like an ID or something that is never going to blank) and use that in the IF statement too
Sub Errormsg ()
count2 = Range("B:B").SpecialCells(xlLastCell).Row
For n = 2 To count2
If Range("K" & n).Value = vbNullString AND Range("A" & n).Value <> "" Then
Range("K" & n).Interior.ColorIndex = 3
MsgBox "Error ! Null value "
Exit Sub
End If
Next n
End Sub
Actually, your code is also work the last row. Just remove last row from loop. It will OK.
Sub Errormsg ()
count2 = Range("B:B").SpecialCells(xlLastCell).Row
For n = 2 To count2 - 1 'Just modify it
If Range("C" & n).Value = vbNullString Then
Range("C" & n).Interior.ColorIndex = 3
MsgBox ("Error ! Null value ")
Exit Sub
End If
Next n
End Sub