PDA

View Full Version : help with select case



vitor
08-21-2018, 08:12 AM
I'm trying to make a code that traverses a number of rows and returns values from those rows.

however, according to the attached worksheet, it does not work with Case the way I put it. I must be missing out on something. It works if I use If.

in case, in cell d1, it should return the value of a16. d2 would return the value of a18, d3 would return the value of a20.
on the first try i am giving a bad result, returning the value of a20 in d1.

although with If seems to work, is a bit counterproductive.
I attached the spreadsheet and the code.

Paul_Hossler
08-21-2018, 09:01 AM
This will not work but is just a example of Case

Based on the value of the Selector (in Select Case) on of the Case …. statements is selected and associated code executed




Option Explicit

Sub extrair()
Dim i As Long

For i = 1 To 20
Select Case Worksheets("ddp").Cells(i, 1).Value

Case "3.3190.03.01"
Worksheets("ddp").Cells(1, 4).Value = Worksheets("ddp").Cells(i, 1).Value

Case "3.3190.03.03"
Worksheets("ddp").Cells(2, 4).Value = Worksheets("ddp").Cells(i, 1).Value

Case "3.3190.03.86"
Worksheets("ddp").Cells(3, 4).Value = Worksheets("ddp").Cells(i, 1).Value

End Select
Next i
End Sub




I think you're looking for something like this





Sub OptionalWay()
Dim r As Range
Dim i As Long
Dim v As Variant


With Worksheets("ddp")

v = Application.WorksheetFunction.Transpose(.Cells(1, 1).CurrentRegion.Columns(1).Value)

For Each r In .Cells(1, 3).CurrentRegion.Cells
For i = LBound(v) To UBound(v)
If Len(v(i)) > 0 Then
If InStr(v(i), r.Value) > 0 Then
r.Offset(0, 1).Value = v(i)
Exit For
End If
End If
Next i
Next
End With
End Sub

p45cal
08-21-2018, 09:05 AM
I don't think Select Case is a good thing to use here. Try:
Sub extrair()
With Worksheets("ddp")
For Each cll In .Range(.Cells(1, "C"), .Cells(.Rows.Count, "C").End(xlUp)).cells
For Each celle In .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp)).cells
If InStr(1, celle.Value, cll.Value) Then
cll.Offset(, 1).Value = celle.Value
Exit For
End If
Next celle
Next cll
End With
End Sub


edit post posting: Ha! just 4 minute after Paul's solution.

vitor
08-21-2018, 10:17 AM
thank you my friends.