I'm fairly new to VBA. Basically, my code attempts to output a classification based on the maximum value in an area column, which is has several categories. The logic seems right but I keep on getting a #VALUE! error. Any help would be much appreciated!
Public Function luclass(NAPS As Double) As String
Dim lastrow As Long
Dim c As Range, rng As Range
Dim maxclass As String
Dim maxshape As Double
With ThisWorkbook.Worksheets("LandUseClass2")
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
maxclass = "Blank"
maxshape = 0
For Each c In .Range("B2:B650" & lastrow)
If c.Value = NAPS Then
If .Range("F" & c.Row).Value > maxshape Then
.Range("C" & c.Row).Text = maxclass
End If
End If
Next c
End With
luclass = maxclass
End Function
Change .Range("B2:B650" & lastrow) to .Range("B2:B" & lastrow)
Change .Range("C" & c.Row).Text = maxclass to .Range("C" & c.Row).Value = maxclass as .text is a readonly property.
You are getting the #Value error because you are trying to write to a range in a function.
Use a Sub instead of a Function or explain what exactly are you tying to achieve and we will take it form there :)
Public Sub luclass(NAPS As Double)
Related
i would like to come up with vba sub that searching value from one specified cell (job) across all sheets and then pastes rows but only with selected columns. If value not found any error message instead paste value.
I know it's bigger project but I'm fresh so try to my best.
As far i have solution for whole rows:
Sub TEST()
Dim tws As String
Dim l_row As String
Dim l_rowR As String
Dim job As String
Dim i As Integer
Set tws = ThisWorkbook.Sheets("Data")
tws.Range("A20") = "STATS:"
job = tws.Range("B5")
lastRow = Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To lastRow
If Worksheets("Sheet1").Range("E" & i).Value = job And _
Worksheets("Sheet1").Range("D" & i).Value = "x2" Then
Worksheets("Sheet1").Rows(i).Copy
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
tws.Range("A" & lastRowRpt + 1).Select
tws.Paste
End If
Next i
End Sub
I'm trying to convert a column of values from Decimal to Binary and for some reason I get this error. I'm new to VBA coding so i might be missing on some basic information.
The code I have:
Private Sub CommandButton1_Click()
Dim i As Integer
Dim r As Range
Dim myRange As Range: Set myRange = Range("E2:E2000") 'define your range
Dim rcopy As Range
Dim myCopyRange As Range: Set myCopyRange = Range("P2:P2000") 'range for the converted values
For i = 1 To myRange.Cells.Count
myCopyRange.Cells(i).Value = WorksheetFunction.Dec2Bin(myRange.Cells(i).Value)
Next
End Sub
My E column with the values that must be converted is set on Number format, and my P column is set right now on Text. However I tried changing the format of the columns to Number or General and I keep on getting the same error.
Thank you for the help:)
So a few things:
1). Dec2Bin can't handle numbers larger than 511 and will throw a 1004Error if you try to do so.
2). You might want to use long variable for numbers, there is no point really to use integer.
3). Another way in doing this would be like:
Private Sub CommandButton1_Click()
Dim i As Long, LR as Long
With Sheets(1)
LR = .Range("E" & .Rows.Count).End(xlUp).Row
For i = 1 To LR
If .Cells(i, 5).value < 512 then .Cells(i, 16).Value = WorksheetFunction.Dec2Bin(.Cells(i, 5).value)
Next i
End with
End Sub
EDIT
You could also opt to include a formula in your loop that will work with 32bit like so:
Private Sub CommandButton1_Click()
Dim i As Long, LR As Long
With Sheets(1)
LR = .Range("E" & .Rows.Count).End(xlUp).Row
For i = 1 To LR
.Cells(i, 16).Formula = "=DEC2BIN(E" & i & "/512^3,5) & DEC2BIN(INT(MOD(E" & i & ",512^3)/512^2),9) & DEC2BIN(INT(MOD(E" & i & ",512^2)/512),9) & DEC2BIN(MOD(E" & i & ",512),9)"
Next
End With
End Sub
EDIT2
For a dynamic sized bitnumber, you might want to use a UDF. See below:
Function DecToBin(ByVal DecimalIn As Variant, Optional NumberOfBits As Variant) As String
DecToBin = ""
DecimalIn = CDec(DecimalIn)
Do While DecimalIn <> 0
DecToBin = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) & DecToBin
DecimalIn = Int(DecimalIn / 2)
Loop
If Not IsMissing(NumberOfBits) Then
If Len(DecToBin) > NumberOfBits Then
DecToBin = "Error - Number too large for bit size"
Else
DecToBin = Right$(String$(NumberOfBits, "0") & _
DecToBin, NumberOfBits)
End If
End If
End Function
And this is how you incorporate this:
Private Sub CommandButton1_Click()
Dim i As Long, LR as Long
With Sheets(1)
LR = .Range("E" & .Rows.Count).End(xlUp).Row
For i = 1 To LR
.Cells(i, 16).Value = "'" & DecToBin(.Cells(i, 5).value)
Next i
End with
End Sub
Here is a usefull Link
You could also just call the function from your worksheet typing this formule:
=DecToBin(E1)
Hope that helps :)
Try this:
Sub test()
Dim i
For i = 2 To 2000
Cells(i, "P").Value = Application.Dec2Bin(Cells(i, "E").Value)
Next i
End Sub
Dec2Bin only accepts numbers, otherwise it throws 1004. So you should check the type of the value before passing it to Dec2Bin, like this:
If Typename(myRange.Cells(i).Value)="Double" Then ...
Typename returns Double for numbers, other values can be String, Date, Empty.
I have written a code which gives me the errors (if any cell is non numeric) in a separate sheet called "Error_sheet".
But the output is a bit clumsy as it gives me non numeric cell address in a confusing fashion. Like the errors will not be pasted one after another. There will be some blanks in between if there are more than one non Numeric cells.
Sub Test()
Dim LastRow As Long, i As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If IsNumeric(Range("A" & i).Value) Then
Else
Sheets("Error").Range("A" & Row).Value = "Error in" & i & " row of ColumnNAme"
Row = Row + 1
End If
Next i
End Sub
It gives me output like shown below but can I get the output like Error in 7,14 rows of column name in a desired cell of "Error_sheet".
[![Output][1]][1]
[1]: https://i.stack.imgur.com/JqXwq.png
My understanding of what you've written is that you want something like this.
Option Explicit
Sub Test()
' Unqualified book/sheet below, means code will always run the isnumeric check on the cells of the active sheet. Is that what you want? '
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim Index as long
Dim i As Long
Dim NonNumericRows() as string
Redim NonNumericRows(1 to lastrow)
For i = 2 To LastRow
If not(IsNumeric(Range("A" & i).Value)) Then
Index = index + 1
NonNumericRows(Index) = cstr(i)
End if
Next i
Redim preserve NonNumericRows(1 to index)
Sheets("Error").Range("A1").Value = "Error in row(s): " & strings.join(nonnumericrows,", ") & " of ColumnNAme"
End Sub
Hope it works or helps.
Like QHarr suggested, using Option Explicit is normally a good idea, and try not to use VBA operators as variables.
Also when working with more than 1 sheet, its best to define each in the code. I dont know what your first sheet is called, so please change the line: Set shSource = Sheets("Sheet1") to suit:
Option Explicit
Sub SubErrorSheet()
Dim lr As Long, i As Long
Dim shSource As Worksheet, shError As Worksheet
Set shSource = Sheets("Sheet1")
Set shError = Sheets("Error")
lr = shSource.Range("A" & Rows.count).End(xlUp).Row
For i = 2 To lr
If Not IsNumeric(shSource.Range("A" & i).Value) Then
shError.Range("A" & Rows.count).End(xlUp).Offset(1, 0).Value = "Error in row " & i & " of ColumnNAme"
End If
Next i
End Sub
I am trying to bring a formula inside my vba code and I am getting an error inside it. Please have a look into the code and kindly share your thoughts.
This is my excel function that was written in VBA Code :
GetUniqueCount(Range,Value)
And here is the VBA Code trying to make use of it :
Sheets("sheet2").Activate
With ThisWorkbook.Sheets("sheet2").UsedRange
lastrow = .Rows(.Rows.Count).Row
End With
For i = 14 To lastrow
check = Range("h" & i).Value
If check <> "" Then
Range("I" & i).Value = WorksheetFunction.GetUniqueCount(sheet1!.Range("A1:B100"), check)
Else
Range("I" & i).Value = ""
Next
The range for the function comes from a different sheet. How do I write it in VBA?
This is the function for it :
Function GetUniqueCount(Rng1 As Range, Lookup As String) As Long
Dim x, dict
Dim i As Long, cnt As Long
Set dict = CreateObject("Scripting.Dictionary")
x = Rng1.Value
For i = 1 To UBound(x, 1)
If x(i, 1) = Lookup Then
dict.Item(x(i, 1) & x(i, 2)) = ""
End If
Next i
GetUniqueCount = dict.Count
End Function
You have other possible errors in your code, unqualified Range, etc.
Since your Function GetUniqueCount is not Excel's built in WorksheetFunction, but your own UDF, you don't need to call it with WorksheetFunction.GetUniqueCount but just GetUniqueCount.
Try the code below:
Option Explicit
Sub Test()
Dim LastRow As Long, i As Long
Dim check As String
With ThisWorkbook.Worksheets("sheet2")
LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row
Dim Rng As Range
Set Rng = Worksheets("sheet1").Range("A1:B100")
For i = 14 To LastRow
check = .Range("H" & i).Value
If check <> "" Then
.Range("I" & i).Value = GetUniqueCount(Rng, check)
Else
.Range("I" & i).Value = ""
End If
Next i
End With
End Sub
There is no worksheet function by the name of GetUniqueCount. If this is a function you have in your code then the way to call it would be like this:-
Range("I" & i).Value = GetUniqueCount("Sheet1".Range("A1:B100"), check)
This code presumes that your function is either on the same code sheet as the calling procedure or declared public. It must take two arguments, the first of which must be a range, the second of the same data type as check. If you didn't declare check (which isn't a good idea) then its data type will be Variant.
Hi I'm a bit new to vba so I will try to explain my problem as far as possible.
I have a dataset in Excel in Column A, I have a lot of file names like this:
1. AB000**1234**45.tif
2. AB000**1235**45.tif
3. AB000**1236**45.tif
4. AB000**1237**45.tif
etc..
From this I want to take out all the strong characters and put in column C so it will look like this:
1. 1234
2. 1235
3. 1236
4. 1237
etc..
At the moment I have a code that looks like this:
Sub TakeOut
Dim str1 As String
Dim LR As Long
Dim cell As Range, RNG As Range
LR = Range("A" & Rows.Count).End(xlUp).Row
Set RNG = Range("A1:A" & LR)
For Each cell In RNG
L = Len(RNG)
If L > 0 Then
RNG = ...
End If
Next cell
Range("C:C").Columns.AutoFit
End Sub
I have tried to count left(5) and right(6) but don't know how to take out the 4 character that I want.
Hope you can help me with this.
If you want to take out the strong characters from the string. Try it below. It will take all the Bold Characters in a cell and place it in C column.
Hope you are looking for this?
Sub get_bold_content()
Dim lastrow, i, j, totlength As Long
lastrow = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lastrow
totlength = Len(Range("A" & i).Value)
For j = 1 To totlength
If Range("A" & i).Characters(j, 1).Font.Bold = True Then
outtext = outtext & Range("A" & i).Characters(j, 1).Text
End If
Next j
Range("C" & i).Value = outtext
outtext = ""
Next i
End Sub
Take a look at the Mid() Function link.
usage in your case:
Mid(cell.Value, 6, 4) 'First parameter is the string, 6 is the start character, 4 is length
The easiest way without looping would be something like this:
Sub TakeOut()
Dim rng As Range
Set rng = Range("A1", Range("A" & Rows.Count).End(xlUp))
rng.Offset(, 1) = Evaluate("IF(" & rng.Address & "="""","""",MID(" & rng.Address & ",6,4))")
End Sub