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
Related
I'm trying to lookup a cell value in another sheet. When I use the following code, the output for debug.print is Error 2042. if I replace Cells(i, store).Value with a static value like "39875", it works perfectly.
With Sheets("250")
numCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
numRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
Dim store
Dim agType
For i = 1 To numCol
If Trim(Cells(1, i).Value) = "Balancing Seg" Then store = i
If Trim(Cells(1, i).Value) = "Ag Type" Then agType = i
Next
Sheets("Worksheet").Activate
For i = numRows To 1 Step -1
With Worksheets("250")
x = Application.VLookup(Cells(i, store).Value, .Range("A1:I" & .Range("A1", .Range("A1").End(xlDown)).Rows.Count), 9, False)
End With
Debug.Print (x)
Next
Am I doing something wrong with the first argument of the VLookup?
I am working on an accounting VBA program that will post Journal entries to a Ledger, and then generate trial balances (i.e. print out the values on a new sheet following "Bal. " in the Ledger). To do this, I need a way to assign the numerical part of the balance cells to a variable or collection. Unfortunately, when I use Debug.Print I see the only value stored is 0 (I am testing just with Common Stock). My expression is: y = Application.Evaluate("=SUM(R[-" & x & "]C:R[-1]C)-SUM(R[-" & x & "]C[1]:R[-1]C[1])") where y represents the balance of Common Stock. How do I properly store the balance value in a variable?
' TODO BE ABLE TO RUN MULTIPLE TIMES
' CHECK FOR POSTED MARK & START WRITING WHEN
' r = "one of the keys", or just creates new Ledger Worksheet every time
Sub MacCompileData()
Application.ScreenUpdating = False
Dim lastRow As Long, x As Long
Dim data, Key
Dim r As Range
Dim cLedger As Collection, cList As Collection
Set cLedger = New Collection
With Worksheets("Journal")
lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
For x = 2 To lastRow
Key = Trim(.Cells(x, 2))
On Error Resume Next
Set cList = cLedger(Key)
If Err.Number <> 0 Then
Set cList = New Collection
cLedger.Add cList, Key
End If
On Error GoTo 0
cLedger(Key).Add Array(.Cells(x, 1).Value, .Cells(x, 3).Value, .Cells(x, 4).Value)
Worksheets("Journal").Cells(x, 5).Value = ChrW(&H2713)
Next
End With
With Worksheets("Ledger")
Dim IsLiability As Boolean
Dim y As Integer
For Each r In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
If r <> "" Then
On Error Resume Next
Key = Trim(r.Text)
If Key = "LIABILITIES" Then
IsLiability = True
End If
data = getLedgerArray(cLedger(Key))
If Err.Number = 0 Then
Set list = cLedger(Key)
x = cLedger(Key).Count
With r.Offset(2).Resize(x, 3)
.Insert Shift:=xlDown, CopyOrigin:=r.Offset(1)
.Offset(-x).Value = data
If IsLiability Then
.Offset(0, 2).Resize(1, 1).FormulaR1C1 = "=""Bal. "" & TEXT(SUM(R[-" & x & "]C:R[-1]C)-SUM(R[-" & x & "]C[1]:R[-1]C[1]),""$#,###"")"
' LOOK HERE FOR Y
y = Application.Evaluate("=SUM(R[-" & x & "]C:R[-1]C)-SUM(R[-" & x & "]C[1]:R[-1]C[1])")
Debug.Print "Common Stock Balance Equals "; y
Else
.Offset(0, 1).Resize(1, 1).FormulaR1C1 = "=""Bal. "" & TEXT(SUM(R[-" & x & "]C:R[-1]C)-SUM(R[-" & x & "]C[1]:R[-1]C[1]),""$#,###"")"
End If
r.Offset(1).EntireRow.Delete
End With
End If
On Error GoTo 0
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Function getLedgerArray(c As Collection)
Dim data
Dim x As Long
ReDim data(1 To c.Count, 1 To 3)
For x = 1 To c.Count
data(x, 1) = c(x)(0)
data(x, 2) = c(x)(1)
data(x, 3) = c(x)(2)
Next
getLedgerArray = data
End Function
Here is a solution that I was able to figure out, though I am not sure if it is the most efficient. In line before the formula is set, I set a Range named BalanceCell to the cell where the formula will be written. I then used the Mid Function to get the string number value from the cell (since the length of "Bal. " is always 5 characters) after the formula is put into BalanceCell.
If IsLiability Then
Set BalanceCell = .Offset(0, 2).Resize(1, 1)
BalanceCell.FormulaR1C1 = "=""Bal. "" & TEXT(SUM(R[-" & x & "]C:R[-1]C)-SUM(R[-" & x & "]C[1]:R[-1]C[1]),""$#,###"")"
y = Mid(BalanceCell.Value, 6, Len(BalanceCell.Value))
Debug.Print "Common Stock Balance is "; y
I have done the following 2 VBA code in excel. Main purpose is to combine multiple address rows into a single line. Problem is it takes forever to run. Is there anyway I can optimise it?
The data is as such, there is a case# for each of the customer address. The customer address can be split into multiple rows. Example: "Address row 1 - Block 56", "Address row 2 - Parry Avenue", "address row 3 - Postal code". There is a blank space between each new address.
My purpose is to combine the address into a single line, and remove the empty rows in between the case numbers eg "Block 56 Parry Avenue Postal code". There are approx 26K case numbers.
Sub test()
Dim l As Long
Dim lEnd As Long
Dim wks As Worksheet
Dim temp As String
Application.EnableEvents = False
Application.ScreenUpdating = False
Set wks = Sheets("data")
wks.Activate
lEnd = ActiveSheet.UsedRange.Rows.Count
For l = 3 To lEnd
If Not IsEmpty(Cells(l, 1)) Then
Do Until IsEmpty(Cells(l + 1, 4))
temp = Cells(l, 4).Value & " " & Cells(l + 1, 4).Value
Cells(l, 4).Value = temp
Cells(l + 1, 4).EntireRow.Delete
Loop
Else: Cells(l, 1).EntireRow.Delete
Do Until IsEmpty(Cells(l + 1, 4))
temp = Cells(l, 4).Value & " " & Cells(l + 1, 4).Value
Cells(l, 4).Value = temp
Cells(l + 1, 4).EntireRow.Delete
Loop
End If
Next l
End Sub
and the 2nd code I tried
Sub transformdata()
'
Dim temp As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("A3").Select
Do Until IsEmpty(ActiveCell) And IsEmpty(ActiveCell.Offset(1, 0))
Do Until IsEmpty(ActiveCell.Offset(1, 3))
temp = ActiveCell.Offset(, 3).Value & " " & ActiveCell.Offset(1, 3).Value
ActiveCell.Offset(, 3).Value = temp
ActiveCell.Offset(1, 3).EntireRow.Delete
Loop
ActiveCell.Offset(1, 0).EntireRow.Delete
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Change the line lEnd = ActiveSheet.UsedRange.Rows.Count. Incorrect way of finding last row. You may want to see This
To delete rows where Cells(l, 1) is empty, use Autofilter. See This
Do not delete rows in a straight loop. Use a reverse loop. Or what you could do is identify the cells that you want to delete in a loop and then delete them in one go after the loop. You may want to see This
Here is a basic example.
Let's say your worksheet looks like this
If you run this code
Sub test()
Dim wks As Worksheet
Dim lRow As Long, i As Long
Dim temp As String
Application.ScreenUpdating = False
Set wks = Sheets("data")
With wks
'~~> Find Last Row
lRow = .Range("C" & .Rows.Count).End(xlUp).Row
For i = lRow To 2 Step -1
If Len(Trim(.Range("C" & i).Value)) <> 0 Then
If temp = "" Then
temp = .Range("C" & i).Value
Else
temp = .Range("C" & i).Value & "," & temp
End If
Else
.Range("D" & i + 1).Value = temp
temp = ""
End If
Next i
End With
End Sub
You will get this output
Now simply run the autofilter to delete the rows where Col D is empty :) I have already give you the link above for the same.
The code below will copy all the data into an array, consolidate it, and add it to a new worksheet. You'll need to make COLUMNCOUNT = the number of columns that contain data.
Sub TransformData2()
Const COLUMNCOUNT = 4
Dim SourceData, NewData
Dim count As Long, x1 As Long, x2 As Long, y As Long
SourceData = Range("A" & Range("D" & Rows.count).End(xlUp).Row, Cells(3, COLUMNCOUNT))
For x1 = 1 To UBound(SourceData, 1)
count = count + 1
If count = 1 Then
ReDim NewData(1 To 4, 1 To count)
Else
ReDim Preserve NewData(1 To 4, 1 To count)
End If
For y = 1 To UBound(SourceData, 2)
NewData(y, count) = SourceData(x1, y)
Next
x2 = x1 + 1
Do
NewData(4, count) = NewData(4, count) & " " & SourceData(x2, 4)
x2 = x2 + 1
If x2 > UBound(SourceData, 1) Then Exit Do
Loop Until IsEmpty(SourceData(x2, 4))
x1 = x2
Next
ThisWorkbook.Worksheets.Add
Range("A1").Resize(UBound(NewData, 2), UBound(NewData, 1)).Value = WorksheetFunction.Transpose(NewData)
End Sub
In my code I keep having the error "Runtime error 13 - type mismatch"
When I put the lines in comment that get the value from the Cell to put in the integer (qtyCode = Cells(x, "L").Value) , this disappears. But I can't seem to find out why it's type mismatch.
Column L is set as number in my excel file.
Sub counting()
Dim code As String
Dim lookup As String
Dim qtyCode As Integer
Dim qtyLookup As Integer
Dim numRows As Integer
numRows = Range("AM2", Range("AM2").End(xlDown)).Rows.Count
For x = 1 To numRows
code = Cells(x, "AM").Text
qtyCode = Cells(x, "L").Value 'error here
For y = 1 To numRows
lookup = Cells(y, "AM").Text
If (code = lookup) Then
qtyLookup = CInt(Cells(y, "L").Text) 'error here
qtyCode = qtyCode + qtyLookup
End If
ActiveCell.Offset(1, 0).Select
Next
Cells(x, "AN").Value = qtyCode
ActiveCell.Offset(1, 0).Select
Next
End Sub
I assume the solution will be easy and I'm overlooking something most likely..
Thanks in advance,
David
This is the code, there is still something wrong with the value output, but no more errors so this question is solved :)
Sub counting()
Dim code As String
Dim lookup As String
Dim a As Long
Dim b As Long
Dim c As Long
Dim numRows As Integer
numRows = Range("AM2", Range("AM2").End(xlDown)).Rows.Count
For x = 2 To numRows
code = Cells(x, "AM").Text
a = CLng(Cells(x, "L").Value)
For y = 2 To numRows
lookup = Cells(y, "AM").Text
If (code = lookup) Then
b = CLng(Cells(y, "L").Value)
c = a + b
End If
Next
Cells(x, "AN").Value = c
Next
End Sub
Add debugging info when error occurs:
Sub counting()
On Error GoTo ErrorTrap
Dim code As String
Dim lookup As String
Dim qtyCode As Integer
Dim qtyLookup As Integer
Dim numRows As Integer
numRows = Range("AM2", Range("AM2").End(xlDown)).Rows.Count
For x = 1 To numRows
code = Cells(x, "AM").Text
mydbgval=Cells(x, "L").Value
qtyCode = Cells(x, "L").Value 'error here
For y = 1 To numRows
lookup = Cells(y, "AM").Text
If (code = lookup) Then
mydbgval=CInt(Cells(y, "L").Text)
qtyLookup = CInt(Cells(y, "L").Text) 'error here
qtyCode = qtyCode + qtyLookup
End If
ActiveCell.Offset(1, 0).Select
Next
Cells(x, "AN").Value = qtyCode
ActiveCell.Offset(1, 0).Select
Next
Exit Sub
ErrorTrap:
Beep
MsgBox "FAILED" & Chr(13) & "Error number: " & Err & Chr(13) & Error(Err) & Chr(13) & "dbgval:<" & mydbgval & ">"
End Sub
the main issue is you have to declare all variables used to reference columns/rows indexes as of Long type, since sheet columns/rows number can exceed the capacity of an Integer variable.
Also
get in the habit of placing Option Explicit statement at the very top of your module, thus forcing yourself to declare ALL variables and get much more control of your code.
use fully qualified references up to the worksheet ones to be sure what range you'r dealing with.
change the way you count rows (see code below)
these are only a few suggestions as long as coding habits are concerned, which may result as follows:
Option Explicit '<== always use this
Sub counting()
Dim code As String
Dim lookup As String
Dim qtyCode As Integer
Dim qtyLookup As Integer
Dim x As Long, y As Long
Dim numRows As Long
With ThisWorkbook.Worksheets("MySheet") '< change it as per your needs
numRows = .Range("AM2", .Cells(.Rows.Count, "AM").End(xlUp)).Rows.Count 'get the last non blank row of column "AM"
For x = 1 To numRows
code = Cells(x, "AM").Text
qtyCode = Cells(x, "L").Value
For y = 1 To numRows
lookup = Cells(y, "AM").Text
If (code = lookup) Then
qtyLookup = CInt(Cells(y, "L").Text)
qtyCode = qtyCode + qtyLookup
End If
ActiveCell.Offset(1, 0).Select
Next y
Cells(x, "AN").Value = qtyCode
ActiveCell.Offset(1, 0).Select
Next x
End With
End Sub
Finally I din't grasp the logic of your code: you start counting rows form row 2 of column "AM"but then iterate from row 1.
may be you can picture a thorough scenario
Not sure if this the source of your error, but remember that Cells() is 0 based. That means that to refer to cell F7, you have to use Cells(6,"F").
So you should perhaps review you FOR...NEXT statement accordingly, using something like:
For x = 0 To numRow - 1
For a more readable code avoiding this difference, you can also use Range("F" & x). Perhaps slightly less efficient but I feel it more comfortable to debug.
EDIT: Cells() is NOT 0 based, but rather 1 based. Sorry for the misinformation, but glad it helped to fix the issue.
I want to sum rows from column I to T and display the result in column V.
Currently, my code is:
Sub Sum_column_V()
Dim lastRow As Long, i As Integer, totalItoT As Double, sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Summary")
lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
For i = 1 To lastRow
totalItoT = WorksheetFunction.Sum(Range("I" & i & "T" & i))
Next
sht.Range("V" & i) = totalItoT
End Sub
I get the error message: "Run-time error '1004': Method 'Range' of object' Global failed"
What am I doing wrong?
The initial macro with Nathan_Sav's correction made the code work. However, used a different approach to optimize running time. Here it is:
Sub Sum_column_V()
Sheets("Summary").Select
Dim j As Integer
j = 2
While Cells(j, 1) <> ""
Cells(j, 22) = Application.Sum(Range(Cells(j, 9), Cells(j, 20)))
j = j + 1
Wend
End Sub