The modelnumber, units, and range are selected based on the user's selection
on the form.
All three are drop down boxes. This is what I have so far. The first
section of selects the model number using Find. Then underneath this code a
have a for loop, that is very slow that selected the Units.
For example, say the user entered Model1 (Model) Vdc (Units)and .1V (Range)
it should return the first row.
The code works,but it's riduculously slow. Mostly, because of the For loop
and the deleting the rows that don't match, I think.
Ideally, I would like to at least comibine the Model and units into using 1
find function. But, I don't know how to do that.
FindModel = Me.ModelNumber.Value
MyUnits = Me.Units.Value
MyRange = Me.Units.Value
'Select Model from Instrument Sheet and copy to SelectedIns Sheet
With WS3.Range("All")
'Note that we need to "look in" values
Set R = .Find(FindModel, Lookat:=xlWhole, LookIn:=xlValues)
Set Destination = Worksheets("SelectedIns").Range("A2")
'If a match is found
If Not R Is Nothing Then
'Store the address of the cell where the first match is found in a
variable.
FindModel = R.Address
'Start to loop.
Do
'Color the cell where a match is found grey.
'R.Interior.ColorIndex = 15
R.Resize(1, 7).Copy Destination:=Destination
'Search the next cell with a matching value.
Set R = .FindNext(R)
Set Destination = Destination.Offset(R.Rows.Count)
'Loop as long matches are found, and the address of the cell where a
match is found,
'is <> as the address of the cell where the first match is found
(FindModel).
Loop While Not R Is Nothing And R.Address <> FindModel
End If
End With
'Find Units in SelectedIns Sheet and delete other units
For i = WS4.Cells(Rows.Count, "G").End(xlUp).Row To 2 Step -1
If (WS4.Cells(i, "G").Value = MyUnits) Then
totalRows = totalRows + 1
Else
WS4.Cells(i, "G").EntireRow.Delete
End If
Next i
'Find number of rows of matching units
MsgBox "" & totalRows & ""
Run "FixName2"
'Error Processing for no units for that instrument
If (totalRows = 0) Then
MsgBox "That model does not have data for those units." & vbCr & "Select
the Add Instrument button to add the data.", vbExclamation, "No Instrument
Data for Model"
Unload Me
Exit Sub
End If
'Copy to calc sheet
If (totalRows = 1) Then
Set Destination2 = ws.Cells(iRow, 11)
WS4.Range("A2:H2").Copy Destination:=Destination2
WS4.Range("$A$2:$G$40").EntireRow.Delete
End If
If (totalRows >= 2) Then
Unload Me
Run "ShowMultipleRange"
WS4.Range("$A$2:$G$40").EntireRow.Delete
Exit Sub
End If
'Select Range
'Find Units in SelectedIns Sheet Copy to Calc Sheet
With WS4.Range("$A$2:$K$200")
'Note that we need to "look in" values
Set R2 = .Find(MyRange, Lookat:=xlWhole, LookIn:=xlValues)
Set Destination = ws.Cells(iRow, 11)
'If a match is found
If Not R2 Is Nothing Then
'Store the address of the cell where the first match is found in a
variable.
MyRange = R2.Address
'Start to loop.
Do
Set R3 = R2.Offset(0, 2)
R3.Offset(0, -6).Resize(1, 7).Copy Destination:=Destination
'Search the next cell with a matching value.
Set R2 = .FindNext(R2)
Set Destination = Destination.Offset(R2.Rows.Count)
'Loop as long matches are found, and the address of the cell where a
match is found,
'is <> as the address of the cell where the first match is found
(FindModel).
Loop While Not R2 Is Nothing And R2.Address <> MyRange
End If
End With
