my newbie question:
I would need to define variable from values gathered by loop.
I have column of datas, and I need to filter those data and copy to another new sheet named with variable.
Problem is, I cannot get variable from loop.
Is it possible?
Example: variable is "hu"
i = 2
Do Until IsEmpty(Cells(i, 9))
**hu** = Cells(i, 9).Value
i = i + 1
Loop
ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = **hu**
Worksheets("Sheet1").Range("A1:I1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$I$1").AutoFilter Field:=9, Criteria1:=**hu**
With ActiveSheet.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng2 Is Nothing Then
MsgBox "No data to copy"
Else
Set rng = ActiveSheet.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Worksheets("Comparison2").Range("A2")
End If
ActiveSheet.ShowAllData
Thanks!
You need to include a subroutine call within your loop to use the variable.
Something like this ..
Option Explicit
Sub do_it()
Dim hu As String
Dim i As Integer
i = 2
Cells(i, 9).Select
Do Until IsEmpty(Cells(i, 9))
hu = Cells(i, 9).Value
get_worksheet (hu)
i = i + 1
Loop
End Sub
Sub get_worksheet(name)
ActiveWorkbook.Worksheets.Add
..etc
end sub
With data like:
In column I, this is a way to get the last item before the empty:
Sub marine()
i = 2
Do Until Cells(i, 9).Value = ""
hu = Cells(i, 9).Value
i = i + 1
Loop
MsgBox hu
End Sub
Ok I googled and found out the problem, error message was due to "This error happens also when a Sub is called the same as variable (i.e. in one Sub you have for loop with iterator "a", whilst another Sub is called "a")."
I changed the name of variable and code works.
Thanks to everyone
Related
It's my first time doing VBA Macro and I'm having a hard time understanding the problem.
I'm trying to filter and color cells with specific values but when I try running the code it says 'Type mismatch'.
Dim count, i As Long
Dim ws As Worksheet
Dim count, i As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
count = ws.Cells(Rows.count, "E").End(xlUp).Row
i = 2
Do While i <= count
If Cells(i, 5).Value = "#N/A" _
Or Cells(i, 5).Value = "#Ref" _
Or Cells(i, 5).Value = "Null" _
Or Cells(i, 5).Value = "" _
Or Cells(i, 5).Value = "#DIV/0!" _
Or Cells(i, 5).Value = "" _
Or Cells(i, 5).Value Like "*-*" Then
Cells(i, 5).Interior.Color = RGB(38, 201, 218)
End If
i = i + 1
Loop
ws.Range("E1").AutoFilter Field:=5, Criteria1:=RGB(38, 201, 218), Operator:=xlFilterCellColor
And when I click the debug it highlights the If statements. Is there a way to solve this or is there a better way to filter these values while highlighting them in VBA?
Not really an answer, more of a expanded comment.
If IsError(Cells(i, 5)) Then
Cells(i, 5).Interior.Color = RGB(0, 0, 255)
ElseIf Cells(i, 5).Value = "" Then
Cells(i, 5).Interior.Color = RGB(0, 0, 255)
Else
Cells(i, 5).Interior.Color = xlNone
End If
Also, this to sift the errors https://learn.microsoft.com/en-us/office/vba/excel/concepts/cells-and-ranges/cell-error-values
First problem: If your cell contain an error, it doesn't contain the string "#N/A" or "#Ref", it contains a special value. What you see is only a visual representation of that error. If you want to check for an error within Excel, you should use the function IsError. That would lead to (wait, don't use that!):
If isError(Cells(i, 5).Value)
Or Cells(i, 5).Value = "Null" _
Or Cells(i, 5).Value = "" _
Or Cells(i, 5).Value Like "*-*" Then
Second problem: In VBA, there is no optimization for a conditional statement, VBA will always evaluate all parts. Your If-statement contains several conditions, combined with Or. While other programming languages quit evaluating when one condition makes the whole expression true, VBA will continue to evaluate all conditions.
Now if you have an error in a cell and you would use the code above, you will still get a type mismatch error: You cannot compare an error with a string. The condition isError(Cells(i, 5).Value) will get True, but VBA will continue to compare the cell content with strings and that gives you the mismatch. You need a way to split your If-statement.
Some more remarks: You are assigning the worksheet you want to work with to variable ws, but you are not using it. You will need to qualify every single usage of Cells (write ws.Cells(i, 5), else VBA will assume you are working with the Active Sheet, and that may or may not be Sheet1. Usually, this is done with a With-statement (note all the leading dots).
Your declaration statement is flawed (a common mistake in VBA), you will need to specify the type for every variable. In your case, Count will be of type Variant, not Long. No problem here, but in other cases it is, so make it a habit to declare all variables correctly.
You should use a For-Loop rather than a Do While.
Dim count As Long, i As Long
With ws
count = .Cells(.Rows.count, "E").End(xlUp).Row
For i = 2 to count
Dim markCell as boolean
If isError(.Cells(i, 5).Value) Then
markCell = True
ElseIf .Cells(i, 5) = "Null" _
Or .Cells(i, 5).Value = "" _
Or .Cells(i, 5).Value Like "*-*" Then
markCell = True
Else
markCell = False
End If
If markCell Then
.Cells(i, 5).Interior.Color = RGB(38, 201, 218)
End If
Next i
End With
If you want to check for specific errors you first need to check if there are errors with IsError. You cannot check for an error and a value in one condition:
Do While i <= count
Dim Condition As Boolean
Condition = False ' initialize when in a loop!
If IsError(Cells(i, 5).Value) Then
If Cells(i, 5).Value = CVErr(xlErrNA) _
Or Cells(i, 5).Value = CVErr(xlErrRef) _
Or Cells(i, 5).Value = CVErr(xlErrNull) _
Or Cells(i, 5).Value = CVErr(xlErrDiv0) Then
Condition = True
End If
ElseIf Cells(i, 5).Value = "" Or Cells(i, 5).Value Like "*-*" Then
Condition = True
End If
If Condition = True Then
Cells(i, 5).Interior.Color = RGB(38, 201, 218)
End If
Loop
Filter By Color
Sub FilterByColor()
Const wsName As String = "Sheet1"
Const Col As String = "E"
Dim FilterColor As Long: FilterColor = RGB(38, 201, 218)
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
If ws.FilterMode Then ws.ShowAllData ' remove any filters
Dim lRow As Long: lRow = ws.Cells(ws.Rows.count, Col).End(xlUp).Row
Dim rgData As Range ' data range; no header
Set rgData = ws.Range(ws.Cells(2, Col), ws.Cells(lRow, Col))
rgData.Interior.Color = xlNone ' remove all colors
Dim rgColor As Range ' the combined range to be colored
Dim DataCell As Range ' each cell of the data range
Dim cString As String
Dim DoColor As Boolean
For Each DataCell In rgData.Cells
If IsError(DataCell) Then ' error value
DoColor = True
Else
cString = CStr(DataCell.Value)
If Len(cString) = 0 Then ' blank
DoColor = True
Else
If InStr(1, cString, "-") > 0 Then ' contains a minus ('-')
DoColor = True
End If
End If
End If
If DoColor Then
If rgColor Is Nothing Then ' combine cells into a range
Set rgColor = DataCell
Else
Set rgColor = Union(rgColor, DataCell)
End If
DoColor = False ' don't forget to reset
End If
Next DataCell
If rgColor Is Nothing Then Exit Sub
rgColor.Interior.Color = FilterColor ' apply color in one go
Dim rgTable As Range ' table range; header included
Set rgTable = ws.Range(ws.Cells(1, Col), ws.Cells(lRow, Col))
rgTable.AutoFilter 1, FilterColor, xlFilterCellColor
' To delete the rows, you could continue with e.g.:
' rgData.SpecialCells(xlCellTypeVisible).EntireRow.Delete
' ws.AutoFilterMode = False ' remove 'AutoFilter'
End Sub
I want to create a userform that can find the "Sales" value in column E and then input the remaining data to the same row.
Set APAC = Sheet2
APAC.Activate
Range("E18:E1888").Select
For Each D In Selection
If D.Value = "TWO.Sales.Value" Then
Exit For
End If
Next D
Rows(D.Row).Select
D.Offset(0, 2).Value = TWO.RSA.Value
D.Offset(0, 3).Value = TWO.Part.Value
D.Offset(0, 4).Value = Application.WorksheetFunction.VLookup(TWO.Part.Value, Worksheets("DataEntry").Range("T2:U70").Value, 2, False)
D.Offset(0, 5).Value = TWO.Program.Value
D.Offset(0, 6).Value = TWO.QTY.Value
Sheet2.Activate
This is my code but
run time error '91'
occurs.
I am having error on the "Rows(D.Row).select" line – Jacob 2 mins ago
That means "TWO.Sales.Value" was not found in Range("E18:E1888") and hence D was nothing. You need to check if the value was found. Also I have a feeling that you wanted If D.Value = TWO.Sales.Value Then instead of If D.Value = "TWO.Sales.Value" Then
Also there is no need to Select/Activate. You can directly work with the objects. You may want to see How to avoid using Select in Excel VBA
Whenever you are working with VLookup, it is better to handle the error that may pop up when a match is not found. There are various ways to do it. I have shown one way in the code below.
Is this what you are trying? (UNTESTED)
Option Explicit
Sub Sample()
Dim APAC As Worksheet
Dim curRow As Long
Dim aCell As Range
Dim Ret
Set APAC = Sheet2
With APAC
For Each aCell In .Range("E18:E1888")
If aCell.Value = TWO.Sales.Value Then
curRow = aCell.Row
Exit For
End If
Next aCell
If curRow = 0 Then
MsgBox "Not Found"
Else
.Range("G" & curRow).Value = TWO.RSA.Value
.Range("H" & curRow).Value = TWO.Part.Value
On Error Resume Next
Ret = Application.WorksheetFunction.VLookup(TWO.Part.Value, _
Worksheets("DataEntry").Range("T2:U70").Value, 2, False)
On Error GoTo 0
If Ret <> "" Then .Range("I" & curRow).Value = Ret
.Range("J" & curRow).Value = TWO.Program.Value
.Range("K" & curRow).Value = TWO.QTY.Value
End If
End With
End Sub
NOTE: If the range .Range("E18:E1888") is dynamic then you may want to find the last row as shown HERE and then use the range as .Range("E18:E" & LastRow)
I type three entries in specific cells
[A2,B2,C2] and run code to take this data to the first empty row in a table.
The code also prevents duplicates based on the entered value in cell B2. If it already exists in the range (B2:B5000) it prevent duplicates.
The problem is it does not ignore the case.
For example:
I enter value "Acetic Acid"
After awhile I add "acetic Acid" or change any letter case.
The code adds it normally without preventing.
How do I ignore the letter case?
Sub tarheel()
LastRow = Range("A10000").End(xlUp).Row + 1
LR = Range("b10000").End(xlUp).Row + 1
For r = 5 To LR
If Cells(r, 2) = Range("b2") Then MsgBox "This Item Name already exist, No shift will done": Exit Sub
Next
Cells(LastRow, 1).Value = Range("A2").Value
Cells(LastRow, 2).Value = Range("B2").Value
Cells(LastRow, 3).Value = Range("C2").Value
Range("A2:C2").Select
Selection.ClearContents
Range("A2").Select
End Sub
thanks for all your replies and i will try it too and give feedback to you.
i could figure it out by adding this line at the top of my module.
Option Compare Text
and it fixed my problem.
thanks
To change case in VBA, you have LCase and UCase, which will respectively change all of your string into lower case or upper case.
Here is your code with the change and got ride of the useless (and ressource-greedy) select at the end :
Sub tarheel()
LastRow = Range("A10000").End(xlUp).Row + 1
LR = Range("b10000").End(xlUp).Row + 1
IsIn = False
For r = 5 To LR
If LCase(Cells(r, 2)) = LCase(Range("b2")) Then _
MsgBox "This Item Name already exist, No shift will done": Exit Sub
Next
Cells(LastRow, 1).Value = Range("A2").Value
Cells(LastRow, 2).Value = Range("B2").Value
Cells(LastRow, 3).Value = Range("C2").Value
Range("A2:C2").ClearContents
'Range("A2").Select
End Sub
You can replace your loop that compares for existing values with a case insensitive one by forcing both values to either upper or lower case.
For r = 5 To LR
If lcase(Cells(r, 2)) = lcase(Range("b2")) Then
MsgBox "This Item Name already exist, No shift will done"
Exit Sub
end if
Next
It may be more efficient to use a case-insensitive worksheet function to check the whole range at once.
If cbool(application.countif(Range("B5:B" & LR), Cells(r, 2))) Then
MsgBox "This Item Name already exist, No shift will done"
Exit Sub
end if
Another possible:
If not iserror(application.match(Cells(r, 2), Range("B5:B" & LR), 0)) Then
MsgBox "This Item Name already exist, No shift will done"
Exit Sub
end if
Sub tarheel()
LastRow = Range("A10000").End(xlUp).Row + 1
LR = Range("b10000").End(xlUp).Row + 1
IsIn = False
For r = 5 To LR
If LCase(Cells(r, 2)) = LCase(Range("b2")) Then _
MsgBox "This Item Name already exist, No shift will done": Exit Sub
Next
Cells(LastRow, 1).Value = Range("A2").Value
Cells(LastRow, 2).Value = Range("B2").Value
Cells(LastRow, 3).Value = Range("C2").Value
Range("A2:C2").ClearContents
'Range("A2").Select
End Sub
I am trying to do a loop through the columns of two rows to add data from one sheet to another. This is additional data that was not dealt with in the previous code (since the previous code had specific logic to populate it).
I tried creating a sub to loop through the current rows on each page, but I am getting a byreference error. One of the ranges is the whole destination row, which is offset (incremented) every time it is populated. The other range is the source material, and covers a column in the source sheet. Other columns are accessed via offset. It am doing much of my work in a For/Each of the source range.
When I create the sub and try to pass the second range (bar), I get the error. I am trying to access the 'bar' object in the For/Each, so that both pages are dealing with the same row. This doesn't appear to be working.
Do I need to reDim, or find some other way to pass the appropriate range to the looping function?
Relevant code:
looping sub (very simple) -
Private Sub LoopThru38(thisRow As Range, sourceRow As Range)
Dim counter As Integer
For counter = 1 To 35
thisRow.Cells(1, 8 + counter).Value = sourceRow.Cells(1, 19 + counter)
Next counter
End Sub
Where I pass it -
ElseIf bar.Cells(1, 19) = prevComp And bar.Cells(1, 19).Value = foo.Cells(1, 2).Value Then ' compare if prev and current comp match
' add other DTCs of this component
destRange.Cells(1, 1).Value = idNumber
destRange.Cells(1, 2).NumberFormat = "#"
destRange.Cells(1, 2).Value = CStr(objectNumber + dotNumber - 0.01) & "-" & CStr(dashNumber)
destRange.Cells(1, 3).Value = "3"
destRange.Cells(1, 5).Value = bar.Cells(1, 6).Value '
destRange.Cells(1, 6).Value = bar.Cells(1, 10) ' foo.Cells(1, 3).Value & " - " & foo.Cells(1, 4)
destRange.Cells(1, 7).Value = bar.Cells(1, 11)
destRange.Cells(1, 8).Value = "FMI " & bar.Cells(1, 11) & ": " & bar.Cells(1, 13)
LoopThru38 destRange, bar ' loops through rest of 38 col to populate export sheet
Set destRange = destRange.Offset(1, 0)
idNumber = idNumber + 1
dashNumber = dashNumber + 1
End If
Original declarations of the ranges -
With ThisWorkbook
Set WS = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
Set Columns_38 = .Worksheets("Joe")
Set dtcList = .Worksheets("Fred")
Set spnList = .Worksheets("Martha")
End With
'...cont
Set srcRange = dtcList.Range(dtcList.Cells(2, "A"), dtcList.Cells(lastRowSrc, "A"))
Set destRange = WS.Range(WS.Cells(2, 1), WS.Cells(2, 42))
Set spnRange = spnList.Range(spnList.Cells(6, 1), spnList.Cells(lastRowSPN, 1))
spnRange is where I seem to be having issues. It is in the second For loop (bar), and that is where I get the source data for the output. It doesn't want to pass 'bar' into the sub though. Do I need to pass the whole range in there, and figure out where I am at?
Thanks
You need to explicitly declare bar as a Range in the calling loop. If you do not, then it isn't a Range object, but rather a Variant that contains a Range object. This works the same until you try pass it to a function/subroutine argument that is declared ByRef as a specific object-type, like Range.
This will throw an error, because the compiler cannot tell if it really will be a Range type at run-time.
The object type when using a For Each loop on a Range is Range.
Sub DisplayFirstTextInRange(WithinThisRange as Range)
Dim rng As Range
For Each rng in WithinThisRange
If rng.Text <> "" Then
MsgBox rng.Text
Exit Sub
End If
Next rng
End Sub
A more useful way of iterating through ranges may be by Row:
Sub DisplayFirstTextInFirstColumnOfRows(WithinThisRange as Range)
Dim rng As Range
For Each rng in WithinThisRange.Rows
If rng.Cells(1,1).Text <> "" Then
MsgBox rng.Cells(1,1).Text
Exit Sub
End If
Next rng
End Sub
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.