The following code runs but, not getting the results. The information is there in the correct range.
Dim ID As Range
Dim SN As Range
Dim i As Integer
Set ID = Sheet6.Range("B2:B8")
Set SN = Sheet2.Range("C7:C184")
For i = 2 To ID.Cells.count
If ID.Cells(i) = SN.Cells(i) Then
MsgBox "do something"
ID.Cells.Offset(0, 2).Value = SN.Cells.Offset(0, -2).Value
Else
MsgBox "sorry"
End If
Next
i found another code and modified it to my work sheet. This one works great.
Dim i As Long
Dim j As Long
For i = 2 To 40
If Sheet6.Range("C" & i).Value = "" Then
Exit For
End If
For j = 7 To 1000
If Sheet2.Range("c" & j).Value = "" Then
Exit For
End If
If Sheet6.Range("C" & i).Text = Sheet2.Range("c" & j).Text Then
Sheet6.Range("C" & i).Offset(0, 1).Value = Sheet2.Range("c" & j).Offset(0, -2).Value
Sheet6.Range("C" & i).Offset(0, 2).Value = Sheet2.Range("c" & j).Offset(0, 2).Value
Exit For
End If
Next j
Next i
Related
this code almost works but im getting a Error "Method 'Range' of object'_Worksheet' failed" when trying to perform the action.
any ideas?
Dim k As Range
For Each k In Sheet2.Range("h6:zz6").Cells
If k = Sheet4.Range("e1").Value Then
Dim i As Long
Dim j As Long
Dim lrow As Long
For i = 10 To 200
If Sheet4.Range("B" & i).Value = "" Then
Exit For
End If
For j = 7 To 10000
If Sheet2.Range("c" & j).Value = "" Then
Exit For
End If
If Sheet4.Range("B" & i).Text = Sheet2.Range("c" & j).Text Then
***Sheet2.Range(k & j).Value*** = Sheet4.Range("b" & i).Value
Exit For
End If
Next j
Next i
Exit For
End If
Next
***Sheet2.Range(k & j).Value***
This part of your loop does not really refer to any cell addresses. It only refers to the number of the iteration itself. Here, for k = 11 and j = 11 it would just yield "(11 & 11)" (of course, it would present an error), not a particular range/cell.
I would try to replace it with:
***Sheet2.Cells(j,k.Column).Value**
In this code snippet, we use the .Cells to give a reference as to which specific cell in the loop we are going to look at.
Dim k As Range
For Each k In Sheet2.Range("h6:zz6").Cells
If k = Sheet4.Range("e1").Value Then
Dim i As Long
Dim j As Long
Dim lrow As Long
For i = 10 To 200
If Sheet4.Range("B" & i).Value = "" Then
Exit For
End If
For j = 7 To 10000
If Sheet2.Range("c" & j).Value = "" Then
Exit For
End If
If Sheet4.Range("B" & i).Text = Sheet2.Range("c" & j).Text Then
***Sheet2.Cells(j,k.Column).Value*** = Sheet4.Range("b" & i).Value
Exit For
End If
Next j
Next i
Exit For
End If
Next
I created a form that recalls information from a sheet i.e. first and last names. In the name combobox, when typing the name out on the form, if you type a name that isn't located on the list, a mismatch occurs. How do I remedy this? If I remove the 0 value the function no longer matches correctly.
* Call previous fields *
Private Sub ComboBox4_Change()
If Me.ComboBox4.Text <> "" Then
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Database")
Dim i As String
i = Application.Match(Me.ComboBox4.Value, sh.Range("A:A"), 0)
Me.TextBox2.Value = sh.Range("B" & i).Value
If sh.Range("H" & i).Value = "Introduced" Then Me.OptionButton1.Value = True
If sh.Range("H" & i).Value = "Not Introduced" Then Me.OptionButton2.Value = True
Me.ComboBox1.Value = sh.Range("C" & i).Value
Me.ComboBox2.Value = sh.Range("D" & i).Value
Me.ComboBox3.Value = sh.Range("M" & i).Value
Me.TextBox11.Value = sh.Range("J" & i).Value
Me.TextBox10.Value = sh.Range("K" & i).Value
Me.TextBox9.Value = sh.Range("L" & i).Value
Me.TextBox12.Value = sh.Range("I" & i).Value
Me.TextBox5.Value = sh.Range("G" & i).Value
Me.TextBox7.Value = sh.Range("N" & i).Value
End If
End Sub
Sometimes using functions native to VBA makes things a little easier. You can use Range.Find instead of the worksheet function Match for your code.
Dim sh As Worksheet: Set sh = ThisWorkbook.Sheets("Database")
Dim xName As Range
Set xName = sh.Range("A:A").Find Me.ComboBox4.Value
If xName Is Nothing Then
'End sub if not found
MsgBox "Name Not Found - Existing Sub"
Else
'To access the row use xName.Row
Me.TextBox2.Value = sh.Range("B" & xName.Row).Value
'.... rest of code
End If
I'm trying to build a check in my code, with the user input in a textbox, I'm trying to use a vlookup in previous records in a table to check if that unique value as already been used (initialized).
The target range "erpLots" contains text formatted cells, amd after checking using the VarType() function I know that assigning vValue = SpecEntry.TextBox3.Value vValue is a string type, the error that I'm getting "Type missmatch" is when doing the vlookup If Application.VLookup(vValue, erpLots, 1, False) = SpecEntry.TextBox3.Value Then.
I have a hunch that the error revolves around a type missmatch between the value being searched "vValue" and the target range "erpLots".
Here is the code:
Public intA As Integer
Public foundRow As Double
Sub StartButtonClick()
Dim rowCount As Long
Dim ws As Worksheet
Dim stg As String
Dim erpLots As Range
Dim vValue As Variant
Set erpLots = Worksheets("Inspection Data").Range("C2", Range("C2").End(xlDown))
Set ws = Worksheets("Inspection Data")
rowCount = ws.Range("A111111").End(xlUp).Row
'Checking the userform request info is complete
If Trim(SpecEntry.TextBox1.Value) = vbNullString Then
MsgBox "Please enter Operator ID"
ElseIf Trim(SpecEntry.TextBox2.Value) = vbNullString Then
MsgBox "Please scan or enter spec. number."
ElseIf Trim(SpecEntry.TextBox3.Value) = vbNullString Then
MsgBox "Please scan or enter ERP Lot #."
Else
SpecEntry.TextBox1.Value = UCase(SpecEntry.TextBox1.Value)
SpecEntry.TextBox2.Value = UCase(SpecEntry.TextBox2.Value)
SpecEntry.TextBox3.Value = UCase(SpecEntry.TextBox3.Value)
'checking if ERP Lot # already exist in the list
vValue = SpecEntry.TextBox3.Value
MsgBox "vValue is: " & vValue
If Application.VLookup(vValue, erpLots, 1, False) = SpecEntry.TextBox3.Value Then
foundRow = WorksheetFunction.Match(SpecEntry.TextBox3.Value, erpLots, 1)
Range("G" & foundRow).Value = Now()
Range("H" & foundRow).Value = Range("G" & foundRow).Value - Range("E" & foundRow).Value
Range("H" & foundRow).NumberFormat = "h:mm"
Range("H" & foundRow).Value = Range("H" & foundRow).Value * 1440
Range("H" & foundRow).NumberFormat = "000.00"
intA = 2
ws.Activate
With ws.Cells(ws.Rows.Count, Selection.Column).End(xlUp)
.Select ' not required to change the focus/view
ActiveWindow.ScrollRow = foundRow - 1
End With
Exit Sub
Else
With ws.Range("A1")
intA = 1
.Offset(rowCount, 0).Value = SpecEntry.TextBox1.Value
.Offset(rowCount, 1).Value = SpecEntry.TextBox2.Value
.Offset(rowCount, 2).Value = SpecEntry.TextBox3.Value
.Offset(rowCount, 3).Value = Now()
End With
End If
End If
End Sub
My goal is that if the value exist, the information being captured is to be recorded in the same row but different columns, if the value does not exist, the information would become a new record.
If your Application.match() is working, why not dropthe vloopkup and just:
foundRow = Application.Iferror(WorksheetFunction.Match(SpecEntry.TextBox3.Value, erpLots, 1),0)
Then your If statement is:
If foundRow > 0 Then
Range("G" & foundRow).Value = Now()
Range("H" & foundRow).Value = Range("G" & foundRow).Value - Range("E" & foundRow).Value
Range("H" & foundRow).NumberFormat = "h:mm"
Range("H" & foundRow).Value = Range("H" & foundRow).Value * 1440
Range("H" & foundRow).NumberFormat = "000.00"
intA = 2
ws.Activate
With ws.Cells(ws.Rows.Count, Selection.Column).End(xlUp)
.Select ' not required to change the focus/view
ActiveWindow.ScrollRow = foundRow - 1
End With
Exit Sub
Else
With ws.Range("A1")
intA = 1
.Offset(rowCount, 0).Value = SpecEntry.TextBox1.Value
.Offset(rowCount, 1).Value = SpecEntry.TextBox2.Value
.Offset(rowCount, 2).Value = SpecEntry.TextBox3.Value
.Offset(rowCount, 3).Value = Now()
End With
End If
I went with a countif, as a way to check if the input from the user existed in the target range, and then use that as a condition in the if statement.
Public intA As Integer
Public foundRow As Double
Sub StartButtonClick()
Dim rowCount As Long
Dim ws As Worksheet
Dim stg As String
Dim erpLots As Range
Dim vValue As Variant
Dim count As Integer
Set erpLots = Worksheets("Inspection Data").Range("C2", Range("C2").End(xlDown))
Set ws = Worksheets("Inspection Data")
foundRow = 0
count = 0
rowCount = ws.Range("A111111").End(xlUp).Row
'Checking the userform request info is complete
If Trim(SpecEntry.TextBox1.Value) = vbNullString Then
MsgBox "Please enter Operator ID"
ElseIf Trim(SpecEntry.TextBox2.Value) = vbNullString Then
MsgBox "Please scan or enter spec. number."
ElseIf Trim(SpecEntry.TextBox3.Value) = vbNullString Then
MsgBox "Please scan or enter ERP Lot #."
Else
SpecEntry.TextBox1.Value = UCase(SpecEntry.TextBox1.Value)
SpecEntry.TextBox2.Value = UCase(SpecEntry.TextBox2.Value)
SpecEntry.TextBox3.Value = UCase(SpecEntry.TextBox3.Value)
'checking if ERP Lot # already exist in the list and is coming back from labs
vValue = CStr(Trim(SpecEntry.TextBox3.Value))
count = Application.WorksheetFunction.CountIf(erpLots, vValue)
If count >= 1 Then
foundRow = Application.WorksheetFunction.Match(vValue, erpLots, 0) + 1
MsgBox "row to update is: " & foundRow
Range("G" & foundRow).Value = Now()
Range("G" & foundRow).NumberFormat = "mm/dd/yyyy hh:mm"
Range("H" & foundRow).Value = Range("G" & foundRow).Value - Range("E" & foundRow).Value
Range("H" & foundRow).NumberFormat = "d " & Chr(34) & "days" & Chr(34) & " , h:mm:ss"
intA = 2
ws.Activate
With ws.Cells(ws.Rows.count, Selection.Column).End(xlUp)
.Select ' not required to change the focus/view
ActiveWindow.ScrollRow = foundRow - 1
End With
Exit Sub
Else
With ws.Range("A1")
intA = 1
.Offset(rowCount, 0).NumberFormat = "#"
.Offset(rowCount, 0).Value = SpecEntry.TextBox1.Value
.Offset(rowCount, 1).NumberFormat = "#"
.Offset(rowCount, 1).Value = CStr(SpecEntry.TextBox2.Value)
.Offset(rowCount, 2).NumberFormat = "#"
.Offset(rowCount, 2).Value = CStr(SpecEntry.TextBox3.Value)
.Offset(rowCount, 3).Value = Now()
End With
End If
End If
End Sub
I got this code but it doesn't seem to run all the way to the end. Gets stuck and debugger just highlights either the Loop keyword or i = i + 1 row. What am I doing wrong?
I tried If statement or For … Next but nothing seems to work.
Sub Macro1()
'
' Macro1 Macro
'
Dim i As Integer
i = 2
Do Until i > 586
Range("B2").Formula = "=sheet2!CS" & i & ""
Range("B3").Formula = "=sheet2!CR" & i & ""
Range("B4").Formula = "=sheet2!CQ" & i & ""
Range("B5").Formula = "=sheet2!CP" & i & ""
Range("B6").Formula = "=sheet2!CO" & i & ""
Range("B7").Formula = "=sheet2!CN" & i & ""
Range("B8").Formula = "=sheet2!CM" & i & ""
Range("B9").Formula = "=sheet2!CL" & i & ""
Range("B10").Formula = "=sheet2!CK" & i & ""
Range("B11").Formula = "=sheet2!CJ" & i & ""
Range("B12").Formula = "=sheet2!CI" & i & ""
Range("B13").Formula = "=sheet2!CH" & i & ""
Range("B14").Formula = "=sheet2!CG" & i & ""
'Copy and PasteSpecial a Range
Range("AL18").Copy
Worksheets("Sheet2").Range("CV" & i & "").PasteSpecial Paste:=xlPasteValues
i = i + 1
Loop
End Sub
Doesn't seem like there's any problems with the code when I tested it..
Here's your code albeit made shorter and see if it works.
Sub Macro1()
Dim i As Long, j As Long
Dim colltr As String
For i = 2 To 586
For j = 2 To 14
colltr = Split(Cells(1, 99 - j).Address, "$")(1)
Range("B" & j).Formula = "=sheet2!" & colltr & i
Next j
'Copy and PasteSpecial a Range
Worksheets("Sheet2").Range("CV" & i & "").value = Range("AL18").value
Next i
End Sub
A Simple Slow Version
Sub LoopTrouble()
Dim i As Integer
Dim j As Integer
For i = 2 To 586
For j = 1 To 13
Sheet1.Cells(j + 1, 2) = Sheet2.Cells(i, 98 - j)
' Sheet1.Cells(j + 1, "B") = Sheet2.Cells(i, 98 - j)
' Sheet1.Range("B" & j + 1) = Sheet2.Cells(i, 98 - j)
Next
Sheet2.Cells(i, 100) = Sheet1.Cells(18, 38)
Next
End Sub
A Faster 'Semi' Array Version
Sub LoopTroubleFaster()
Dim i As Integer
Dim j As Integer
Dim vntLT As Variant
Dim vntPaste As Variant
vntLT = Sheet2.Range(Cells(2, 85), Cells(586, 97)).Value2
ReDim vntPaste(1 To 13, 1 To 1)
For i = 1 To 585
For j = 1 To 13
vntPaste(j, 1) = vntLT(i, j)
Next
Sheet1.Range("B2:B14") = vntPaste
Sheet2.Cells(i + 1, 100) = Sheet1.Cells(18, 38)
Next
End Sub
I am having trouble making a program work in Excel.
I need loop through all the lines in my excel spreadsheet, and loop through multiple possible cells for each line.
Sub DoubleLoop()
Dim i As Long
Dim Carr As Integer
For i = 2 To 49235
For j = 2 To 27
If Range("P" & i).Value = ("Y" & j) And Range("S" & i).Value = ("Z" & j) And Range("P" & i).Value = ("AA" & j) Then
Range("P" & i).Value = "Keep"
ElseIf j < 27 Then
j = j + 1
ElseIf j = 27 Then
Range("X" & i).Value = "Remove"
End If
Next i
End Sub
As stated in the comments. Use Next j and exit the inner loop when criteria is met.
Sub DoubleLoop()
Dim i As Long, j As Long
Dim Carr As Integer
For i = 2 To 49235
Range("P" & i).Value = "Remove"
For j = 2 To 27
If Range("P" & i).Value = ("Y" & j) And Range("S" & i).Value = ("Z" & j) And Range("P" & i).Value = ("AA" & j) Then
Range("P" & i).Value = "Keep"
Exit For
End If
Next j
Next i
End Sub