here is the code im trying:
Set found = Worksheets("Result").Range("A:A").Find(Prefix, , xlValues, xlWhole)
found.Offset(0, 1).Value = CInt(found.Offset(0, 1).Value) + CInt(C.Offset(0, 1).Value)
Prefix is a 3 digit number that is found in a column, what i then want to do is increase the cell to the right of where it is found by a cell one to the right of "C". I am getting a type mismatch error.
here is where c comes from:
For Each C In Worksheets("AMZ").Range("C2:C" & endRow).Cells
any ideas?
EDIT: Full code
Sub processData()
Dim endRow As Variant
endRow = Worksheets("AMZ").Range("A65536").End(xlUp).Row
For Each C In Worksheets("AMZ").Range("C2:C" & endRow).Cells
Dim found As Range
Prefix = C.Value
C.Select
'remove prefix
If Not Left(Prefix, 3) = "FBA" Then
'nothing
If Mid(Prefix, 3, 1) = "-" Then
Prefix = Left(Prefix, 2)
ElseIf Mid(Prefix, 4, 1) = "-" Then
Prefix = Left(Prefix, 3)
Else
Prefix = "-1"
End If
If Not Prefix = "-1" Then
Set found = Worksheets("Result").Range("A:A").Find(Prefix, , xlValues, xlWhole)
found.Offset(0, 1).Value = CInt(Val(found.Offset(0, 1).Value)) + CInt(Val(C.Offset(0, 1).Value))
End If
End If
Next
End Sub
If found.Offset(0, 1).Value) or CInt(C.Offset(0, 1).Value) are string values, like "" or "1234hello" or anything that does not directly translate to an integer, you get the error you listed.
The easiest way to correct this, is to surround the value with the Val(string) function.
In your circumstance, you would use the following
found.Offset(0, 1).Value = CInt(Val(found.Offset(0, 1).Value)) + CInt(Val(C.Offset(0, 1).Value))
A note about Val, if the values you provide could not possibly be a number, it will default to 0. Otherwise it will take any numbers at the beginning of the string offered. For more about Val read the link. (same as above)
Related
I am running a code that lists me every word that occurs in a given column and the number of times each word occurs(the cells contain text). If I try to run it for my C column that contains larger texts, I get a 'run_time error 1004' in line: 'Cells(MyRow, 7).Value = K'. How could I modify this code to make it work on large amount of data?
Sub WordCount()
Dim Rng As Range, Dn As Range, oMax As Double, K As Variant, Msg As String, vWords As Variant, myWord As Variant
Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
vWords = Split(Dn.Text, " ")
For Each myWord In vWords
If Not .Exists(myWord) Then
.Add myWord, 1
Else
.Item(myWord) = .Item(myWord) + 1
End If
Next
Next
oMax = Application.Max(Application.Transpose(.Items))
MyRow = 2
For Each K In .keys
If .Item(K) = oMax Then
Msg = Msg & K & ","
End If
Cells(MyRow, 8).Value = .Item(K)
Cells(MyRow, 7).Value = K
MyRow = MyRow + 1
Next K
End With
End Sub
Well the issue is you cannot put three === signs in a cell because Excel tries to treat everything that starts with a = as formula and === is no valid formula so it fails.
Replace
Cells(MyRow, 7).Value = K
with
Cells(MyRow, 7).Value = IIf(Left$(K, 1) = "=", "'" & K, K)
this puts a ' infront of everything starting with a = sign. So it is treated as text not formula. Don't worry the apostrophe is not shown in the cell.
I have created a method for defining range between two words and iterate through it to copy paste values from one worksheet to another. There is some strange reason it does not work.
I specify row, it is 18, my code starts from row 20? So it copies everything starting from row 20. O_o
It does not detect range correctly as it copies values below my words as well? I have checked that I don't have same words elsewhere.
Any suggestions?
Here is code for calling method:
Sub dsfdsfdsfds()
copyOptionsToTable 18, CalculationItemOM1
End Sub
Here is method:
Private Sub copyOptionsToTable(RowToPaste As Integer, OperatingWorksheet As Worksheet)
'Dim FirstWord, SecondWord
Dim OptionsRange As Range
Dim cell, x
'Set FirstWord = OperatingWorksheet.Range("W:W").Find("OPTIOONS START", LookIn:=xlValues, lookat:=xlWhole)
'Set SecondWord = OperatingWorksheet.Range("W:W").Find("OPTIOONS END", LookIn:=xlValues, lookat:=xlWhole)
Set OptionsRange = OperatingWorksheet.Range(OperatingWorksheet.Cells.Find("[OPTIOONS START]"), OperatingWorksheet.Cells.Find("[OPTIOONS END]"))
x = 0
' Copy - Paste process
For Each cell In OptionsRange
If Not IsEmpty(cell.Value) Or cell.Value <> "OPT" Then
ThisWorkbook.Worksheets("TableForOL").Range("B" & RowToPaste).Offset(0 + x, 0).Value = cell.Offset(0 + x, -20).Value
ThisWorkbook.Worksheets("TableForOL").Range("B" & RowToPaste).Offset(0 + x, 3).Value = cell.Offset(0 + x, 2).Value
End If
x = x + 1
Next cell
End Sub
Source sheet:
Output sheet:
EDIT:
Output still looks like this?
You're already incrementing cell by one row inside the loop - you don't need to further offset that using x
Set OptionsRange = OperatingWorksheet.Range( _
OperatingWorksheet.Cells.Find("[OPTIOONS START]").Offset(1,0), _
OperatingWorksheet.Cells.Find("[OPTIOONS END]").Offset(-1, 0))
x = 0
' Copy - Paste process
For Each cell In OptionsRange.Cells
If Not IsEmpty(cell.Value) Or cell.Value <> "OPT" Then
With ThisWorkbook.Worksheets("TableForOL").Range("B" & RowToPaste)
.Offset(x, 0).Value = cell.Offset(0, -20).Value
.Offset(x, 3).Value = cell.Offset(0, 2).Value
End With
x = x + 1 '<< only increment if you copied values...
End If
Next cell
Also I'm not sure this line does what you intend?
If Not IsEmpty(cell.Value) Or cell.Value <> "OPT" Then
maybe
If Not IsEmpty(cell.Value) And cell.Value <> "OPT" Then
The below VBA code sets a range of cells as commentArray, removes any blanks from the array and creates a new, blank free array, called commentResults. I then want to declare the array.
There is a possibility, depending on my source data, that the array could then still be empty so the below doesn't work to declare
thisws.Cells(i, 19).Resize(columnsize:=UBound(commentResults) - LBound(commentResults) + 1).Value = commentResults
So I thought I would add a check (the if statement after the debug.print), that only declared the array if array(0) wasn't empty but I continuously get an error 9 which I can't resolve.
Dim commentArray(4) As Variant
commentArray(0) = Cells(24, 4).Value
commentArray(1) = Cells(25, 3).Value
commentArray(2) = Cells(26, 3).Value
commentArray(3) = Cells(27, 3).Value
'a and b as array loops
Dim a As Long, b As Long
Dim commentResults() As Variant
'loops through the array to remove blanks - rewrites array without blanks into commentArray
For a = LBound(commentArray) To UBound(commentArray)
If commentArray(a) <> vbNullString Then
ReDim Preserve commentResults(b)
commentResults(b) = commentArray(a)
b = b + 1
End If
Next a
Debug.Print b
If IsError(Application.Match("*", (commentResults), 0)) Then
Else
thisws.Cells(i, 19).Resize(columnsize:=UBound(commentResults) - LBound(commentResults) + 1).Value = commentResults
b = 0
End If
Any thoughts on why this might not work?
I have also tried:
If commentResults(0) <> vbNullString Then
thisws.Cells(i, 27).Resize(columnsize:=UBound(commentResults) - LBound(commentResults) + 1).Value = commentResults
End If
Sub CommentArray()
Dim Comments As Range, c As Range
Set Comments = Union(Cells(24, 4), Range(Cells(25, 3), Cells(27, 3)))
Dim commentResults() As Variant
Dim i As Long
i = 0
For Each cell In Comments
If cell.Value <> "" Then
ReDim Preserve commentResults(i)
commentResults(i) = cell.Value
i = i + 1
End If
Next cell
Dim debugStr As String
For i = LBound(commentResults) To UBound(commentResults)
debugStr = debugStr & commentResults(i) & Chr(10)
Next i
MsgBox debugStr
End Sub
Right now, I have a code that will generate a name for a folder in a network drive. Once the user types in the name for the new folder in a prompt box, I am trying to add the name into two places: the bottom of a list in a column, and to the end of the list in the first row (the first empty cell in the row)
Currently, my code to put the name at the bottom of the list in column D works:
lMaxRows = Cells(Rows.Count, "D").End(xlUp).Row
Range("D" & lMaxRows + 1) = accountname
where "accountname" is the input that the prompt asks for. Then the code goes to the last cell that was used in the column, goes one additional cell, and fills it with the "accountname".
Is there a way to convert this code to work for a list in a row? I'm trying to build the list from left to right starting in column X of row 1. This is what I have right now, but it's not working and I'm not sure if it's a language issue or something more.
lMaxCol = Cells(1, Columns.Count).End(xlToRight).Column
Range("X1" & lMaxCol + 1) = accountname
Any ideas? Is this a quick fix or will it require a more sophistacted code?
-AC
lMaxCol = Cells(1, Columns.Count).End(xlToRight).Offset(0,1).Column
If lMaxCol<26 Then lMaxCol=26
Cells(1, lMaxCol) = accountname
Dim lMaxCol As Long
With ActiveSheet.Rows(1) 'might want a different sheet
lMaxCol = .Find(what:="", after:=[w1], LookIn:=xlValues, searchdirection:=xlNext).Column
End With
Cells(1, lMaxCol) = AccountName
Note that this should, indeed, find the first empty cell at or after X1. If there is, for example, data in X1 and AA1, the above will return 25, not 28. If this might be an issue, and you prefer to return 28 in that case, you could use something like:
Dim lMaxCol As Long
With ActiveSheet.Range("x1", Cells(1, Columns.Count))
On Error Resume Next
lMaxCol = .Find(what:="*", after:=.Cells(1, .Columns.Count), LookIn:=xlValues, _
searchdirection:=xlPrevious).Column + 1
If Err.Number <> 0 Then lMaxCol = 24
On Error GoTo 0
End With
Cells(1, lMaxCol) = AccountName
If you don't need to know lMaxCol for some other part of the code, this code can be simplified.
Dim C As Range
With ActiveSheet.Range("x1", Cells(1, Columns.Count))
Set C = .Find(what:="*", after:=.Cells(1, .Columns.Count), LookIn:=xlValues, _
searchdirection:=xlPrevious)
If Not C Is Nothing Then
C.Offset(0, 1) = AccountName
Else
Cells(1, 24) = AccountName
End If
End With
What I am doing is search some strings one by one in the entire range - like search for "blah1", if found then exit, else search "blah2" in the entire range in the same manner. "blah's" are searched in one column.
Right now i am just running a For loop code as shown below which so far works ok in my tests...but was wondering if MATCH, FIND or other methods may be faster...any opinion?
Sub test()
Dim LR As Long
LR = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
If Cells(1, "B") = "" Then
For i = 1 To LR
If Cells(i, "A") = "blah1" Then
Cells(1, "B") = Cells(i, "A").Row
Cells(1, "C") = Cells(i, "A")
Exit For
End If
Next i
End If
If Cells(1, "B") = "" Then
For i = 1 To LR
If Cells(i, "A") = "blah2" Then
Cells(1, "B") = Cells(i, "A").Row
Cells(1, "C") = Cells(i, "A")
Exit For
End If
Next i
End If
End Sub
Try this one. Since your code is repeated (for "blah1" and "blah2") I used additional function:
Sub test()
If Sheet1.Cells(1, "B") = "" Then
If findString("blah1") Then Exit Sub
If findString("blah2") Then Exit Sub
End If
End Sub
'Function findString returns TRUE if something found and FALSE otherwise
Function findString(searchString As String) As Boolean
Dim rng As Range, res
With Sheet1
Set rng = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
res = Application.Match(searchString, rng, 0)
'Application.Match returns error if nothing found
findString = Not IsError(res)
If findString Then
.Cells(1, "B").Value = rng.Cells(res, 1).Row
.Cells(1, "C").Value = searchString
End If
End With
End Function
I'm reasonably new to Excel Vba, but my limited understanding is that reading from cells is relatively slow. If I were doing this I would read all the values into an array, and carry out the same for loop as you have used, but on the array, rather than cell values.
To confirm, you could use VBAs Timer function to check speed.
Let me know if you'd like more detailed explanations of how to do this.
Here's how you can turn a range into an array (and vice versa). Step through this code with the Locals window turned on and watch what happens. You are particularly interested in the astrArray variable.
Sub ChangeArray()
'
Dim astrArray As Variant
'
' Dim astrArray
' that is, with no type specified
' is exactly equivalent
'
Dim lngIndex As Long
Dim strMessage As String
'
Range("A1").Value = "This"
Range("A2").Value = "is"
Range("A3").Value = "only"
Range("A4").Value = "a"
Range("A5").Value = "test"
astrArray = Range("A1:A5")
For lngIndex = 1 To 5
strMessage = strMessage & astrArray(lngIndex, 1) & " "
Select Case lngIndex
Case 1
astrArray(lngIndex, 1) = "No,"
Case 2
astrArray(lngIndex, 1) = "it's"
Case 3
astrArray(lngIndex, 1) = "actually"
Case 4
astrArray(lngIndex, 1) = "real"
Case 5
astrArray(lngIndex, 1) = "life"
End Select
Next lngIndex
MsgBox strMessage
Range("A1:A5") = astrArray
End Sub
A key requirement: to do this, the variable must be DIMmed Variant!
Another thing to pay attention to: the variable is two-dimensional, even though the range selected is one-dimensional.