I would like to auto run below statements:
=VLOOKUP(B8,Sheet2!D:H,5,FALSE)
But I got an error at line 6: unable to get the VLookup property of the WorksheetFunction class
Sub Test()
Dim rng As Range
Dim i As Long
With ActiveSheet
Set rng = .Range("B8:D" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For i = 18 to rng.Rows.Count
rng.Cells(8, 6) =
Application.WorksheetFunction.VLookup(.Cells(i,1), Sheets("Sheet2").Range("D:H"), 5, False)
Next
End With
End Sub
Where I want to put my output at SheetT F8, by looking up Sheet2
I suspect you want
Sub Test()
Dim i As Long
With ActiveSheet
For i = 8 to .Cells(.Rows.Count, "B").End(xlUp).Row
.Cells(i, "F").Value = Application.VLookup(.Cells(i, "B").Value, _
Sheets("Sheet2").Range("D:H"), _
5, _
False)
Next
End With
End Sub
Your original code was:
always writing to rng.Cells(8, 6), which is a cell that was B8 offset by 7 rows and 5 columns, i.e. G15 (or C15 in an earlier version)
using ActiveSheet.Cells(i, 1) as the lookup value, which was a cell in column A
Related
This is what my end result should look like. If there is not the four digits to move over to the second column then fill with 4 zeros.
How can I split zip code in a column into 2 columns and fill empty cells in column 2 if first column has only 5 digits?
Here is what I have been working with
Dim ws As Worksheet
Dim cell As Range
Set ws = Worksheets("sheet1")
For Each cell In ws.Range("K2:K500").Cells
cell.Offset(0, 1).Value = Left(cell.Value, 5)
Next cell
Dim cel As Range, rngC As Range, rngB As Range
Dim lastRowA As Long, lastRowB As Long
With ws
lastRowK = .Cells(.Rows.Count, "K").End(xlUp).Row 'last row of column A
lastRowL = .Cells(.Rows.Count, "L").End(xlUp).Row 'last row of column B
For Each cel In .Range("K2:K" & lastRowL) 'loop through column L
'check if cell in column A exists in column B
If WorksheetFunction.CountIf(.Range("K2:K" & lastRowL), cel) = 0 Then
cel.Offset(0, 3).Value = Right(cel.Value, 4)
'.Range("M" & cel.Row) = Right(cell.Value, 4)
Else
.Range("M" & cel.Row) = "0000"
End If
Next
End With
In case you want to bypass VBA and use formulas, you can do this.
Cell B2:
=LEFT(A2,5)
Cell C2:
=IF(LEN(A2)=9,RIGHT(A2,4),"0000")
One of the simplest ways to solve this problem is to supplement the original string with a large number of zeros and take the values of the first and second five characters for two cells:
Sub setZIPandZeros()
Const TEN_ZEROS = "0000000000" ' 10 times
Dim ws As Worksheet
Dim cell As Range
Dim sLongString As String
Set ws = Worksheets("Sheet1")
For Each cell In ws.Range("K2:K" & ws.Cells(ws.Rows.Count, "K").End(xlUp).Row).Cells
sLongString = Trim(cell.Text) & TEN_ZEROS
cell.Offset(0, 1).Resize(1, 2).NumberFormat = "#"
cell.Offset(0, 1).Resize(1, 2).Value = Array(Left(sLongString, 5), _
Mid(sLongString, 6, 5))
Next cell
End Sub
Update The modified code is much faster and gives a result that more closely matches the description of the task:
Sub setZipZeros()
Dim ws As Worksheet
Dim rResult As Range
Set ws = Worksheets("Sheet1")
' Addressing R1C1 is used in the formulas - If the original range
' is shifted to another column, you will need to change the letter
' of the column "K" only in this line
Set rResult = ws.Range("K2", ws.Cells(ws.Rows.Count, "K").End(xlUp)).Offset(0, 1)
' If the columns L:M are already in text format, then instead of
' the results we will get the texts of formulas
rResult.Resize(, 2).NumberFormat = "General"
' These two lines do most of the work:
rResult.Formula2R1C1 = "=LEFT(TRIM(RC[-1])&""00000"",5)"
rResult.Offset(0, 1).Formula2R1C1 = "=MID(TRIM(RC[-2])&""000000000"",6,4)"
' We don't know if auto-recalculation mode is on now
' Application.Calculation = xlAutomatic
ActiveSheet.Calculate
Set rResult = rResult.Resize(, 2)
' Set the text format for the cells of the result
' to prevent conversions "00123" to "123"
rResult.NumberFormat = "#"
' Replace formulas with their values
rResult.Value = rResult.Value
End Sub
Working in Excel VBA.
I'm trying to delete a cell, if there is a date in another cell via VBA.
Or another way to put it, I'm trying to delete a cell, if another cell has ANYthing in it. (As it's either a date, or not.)
Here's my code - I just don't know how to recognise any date in the cell.
Sub Upload1ClearADP()
Dim LastRow As Long, x As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To LastRow
If Cells(x, "G").Value = "Date" Then
Cells(x, "U").ClearContents
End If
Next x
End Sub
You're currently checking for a string Date, not technically an actual date.
Here's your code written to check if it's a date OR is empty:
Sub Upload1ClearADP()
Dim LastRow As Long, x As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To LastRow
If IsDate(Cells(x, "G").Value) or Cells(x, "G") <> "" Then
Cells(x, "U").ClearContents
End If
Next x
End Sub
Edit: As #Harun24HR points out in the comments, the IsDate() is unnecessary, since you check if the cell is not empty (<> ""). I just wanted to put it there to introduce the IsDate() function.
Edit 2: You can also use SpecialCells() to do the clearing in one line:
Sub Upload1ClearADP()
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim dataRng As Range
Set dataRng = Range(Cells(2, "G"), Cells(LastRow, "G"))
' Use 14 because it's 14 columns to the right from
' Column G to U
dataRng.SpecialCells(xlCellTypeConstants).Offset(0, 14).ClearContents
' If you have formulas *and* constants in column G, use:
' Union(dataRng.SpecialCells(xlCellTypeConstants), _
' dataRng.SpecialCells(xlCellTypeFormulas)).Offset(0,14).ClearContents
End Sub
I am trying to have a macro auto-sum the bottom of column L each time I run it while it takes into account that the length of the column varies. I had this code that auto-summed the bottom of a column G, so I switched the G to an L but it is not working as intended. Why is that? Could someone please make an edit to the code so it automatically sums the bottom of column even though the range may vary weekly?
Sheets("Report").Select
Const SourceRange = "A:L"
Dim NumRange As Range, formulaCell As Range
Dim SumAddr As String
Dim c As Long
For Each NumRange In Columns(SourceRange).SpecialCells(xlConstants, xlNumbers).Areas
SumAddr = NumRange.Address(False, False)
Set formulaCell = NumRange.Offset(NumRange.Count, 0).Resize(1, 1)
formulaCell.Formula = "=SUM(" & SumAddr & ")"
c = NumRange.Count
Next NumRange
This would add a SUM total at the bottom of each column between A & L.
Public Sub Add_Total()
Dim ColumnNumber As Long
Dim LastRow As Long
With ThisWorkbook.Worksheets("Report")
For ColumnNumber = 1 To 12
LastRow = .Cells(.Rows.Count, ColumnNumber).End(xlUp).Row
With .Cells(LastRow + 1, ColumnNumber)
.FormulaR1C1 = "=SUM(R2C:R[-1]C)"
.Font.Bold = True
End With
Next ColumnNumber
End With
End Sub
To add it to just column L you could change the code to:
Public Sub Add_Total1()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Report")
LastRow = .Cells(.Rows.Count, 12).End(xlUp).Row
With .Cells(LastRow + 1, 12)
.FormulaR1C1 = "=SUM(R2C:R[-1]C)"
.Font.Bold = True
End With
End With
End Sub
I don't have enough reputation yet to add a comment to reply to your question to Darren - but all you have to do is delete the whole line with "Next" in it from his second set of code; it was the end of the "for" loop that he removed from his first set of code and should have been deleted.
I want to find min value that color value is not fill with red color with Vba code
my code is here:
Private Sub bidcanceled_Click()
Dim HLF As Range, finalHLF
Dim minNum As Double
Dim Lastrow As Integer
Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Set HLF = Range("e2:e" & Lastrow)
Range("e2:e" & Lastrow).Select
minNum = WorksheetFunction.MIN(HLF)
finalHLF = HLF.Find(what:=minNum, Lookat:=xlWhole).Address
Range(finalHLF).Interior.Color = vbGreen
Range(finalHLF).Offset(, 3).Value = "bid canceled"
End Sub
the output must choose the cell = 41 and fill the color with green can any one help to solve that, when i run the code it's choose 37 and fill it with green ..i want it to select non color values and find the min number in that column
As per my comment, I would suggest to implement an AutoFilter on color:
Sample Data:
Sample Code:
Sub Test()
Dim Lr As Long, MinVal As Long
Dim Rng As Range
With Sheet1 'Change according to your sheets CodeName
'Retrieve last used row on column E
Lr = .Cells(.Rows.Count, 5).End(xlUp).Row
'Apply our filter of non-colored cells
Set Rng = .Range("E1:E" & Lr)
Rng.AutoFilter 1, , 12
'First check if any rows are filtered to prevent error on .SpecialCells and color the minimum
If Rng.SpecialCells(12).Count > 1 Then
MinVal = WorksheetFunction.min(Rng.SpecialCells(12))
Rng.SpecialCells(12).Find(MinVal, Lookat:=xlWhole).Interior.Color = vbGreen
Rng.SpecialCells(12).Find(MinVal, Lookat:=xlWhole).Offset(, 3).Value = "bid canceled"
End If
'Get rid of Filter
Rng.AutoFilter
End With
End Sub
Sample Result:
I have the following code to generate Auto Serial Number in Column B and start from B15. It also depends upon Column C cells data records. when the C column cell will go empty at any point then the serial number will stop automatically in Column B.
Sub AutoSRIn()
Dim ws As Worksheet
Set ws = Sheet9
ws.Range("B15").Select
lrow = ws.Cells(Rows.Count, 3).End(xlUp).Row
Set myrange = ws.Range(Cells(15, 3), Cells(lrow, 3))
For Each cell In myrange
cell.Offset(0, -1).Value = i + 1
i = i + 1
Next cell
End Sub
But I am getting an error 'run time error 1004 range of object _worksheet failed at following line number'.
Set myrange = ws.Range(Cells(15, 3), Cells(lrow, 3))
The important and strange thing is that sometimes it works but if used in any other version like excel 2010 it is not working
I am trying to get a result through userform submit button. First, there is code for insert records in C column from C15 then Use this code to get the auto serial number for records.
Please Help Many thanks in advance!
Cells() without a worksheet qualifier will default to the active sheet, so
Set myrange = ws.Range(Cells(15, 3), Cells(lrow, 3))
will fail if ws is not the active sheet.
You need something like:
Set myrange = ws.Range(ws.Cells(15, 3), ws.Cells(lrow, 3))
You could shorten the above code to
Sub AutoSRIn()
With Sheet9
lrow = .Cells(.Rows.Count, 3).End(xlUp).Row
Set myrange = .Range(.Cells(15, 3), .Cells(lrow, 3))
End With
For Each cell In myrange
cell.Offset(0, -1).Value = i + 1
i = i + 1
Next cell
End Sub
Others have mentioned the explicit/implicit sheet reference issues. But you still make use of an iteration through range objects (not bad in itself, but not necessary and slow on a large range).
Alternatively try:
Sub AutoSRIn()
With Sheet9
Dim lr As Long: lr = .Cells(.Rows.Count, 3).End(xlUp).Row
If lr > 14 Then .Range("B15:B" & lr) = .Evaluate("ROW(1:" & lr - 14 & ")")
End With
End Sub
Btw, it's good practice to Dim all your variables to some Data type if possible (Dim myrange As Range and Dim i As Long for example)