Goedemiddag,
Ik hoop dat jullie mij kunnen helpen met het volgende:
Bijgevoegd een vba script dat ik gebruik om te zoeken in andere sheets naar een bepaalde waarde en op basis hiervan gegevens retourneert.
Nu is mij gevraagd of ik het script ook kan laten zoeken naar een combinatie van 2 waardes, dus het script moet zoeken naar Type en als de 1e cel rechts daarvan dezelfde waarde heeft als Pot dan de gevraagde waardes worden geretourneerd.
Hoe ik de vba nu heb aangepast zoekt hij wel alleen kijkt het script of beide waardes in de sheet staan en niet de combinatie van. Hoe kan ik dit erin verwerken? (als het mogelijk is)
Alvast bedankt,
Michael
Ik hoop dat jullie mij kunnen helpen met het volgende:
Bijgevoegd een vba script dat ik gebruik om te zoeken in andere sheets naar een bepaalde waarde en op basis hiervan gegevens retourneert.
Nu is mij gevraagd of ik het script ook kan laten zoeken naar een combinatie van 2 waardes, dus het script moet zoeken naar Type en als de 1e cel rechts daarvan dezelfde waarde heeft als Pot dan de gevraagde waardes worden geretourneerd.
Hoe ik de vba nu heb aangepast zoekt hij wel alleen kijkt het script of beide waardes in de sheet staan en niet de combinatie van. Hoe kan ik dit erin verwerken? (als het mogelijk is)
Code:
Sub Zoek_In_Alle_Sheets()
Dim sht As Worksheet
Dim c As Long
Dim Rng As Range
Dim Rng2 As Range
Dim Type As String
Dim locatie As String
Dim afdeling As String
Dim rij As String
Dim rijnr As Integer
Dim Pot As String
Type = Sheets("Invulblad").Range("B5")
Pot = Sheets("Invulblad").Range("C5")
Application.ScreenUpdating = False
Workbooks(2).Activate
For Each sht In Worksheets
If sht.Name <> "Invulblad" And sht.Name <> "ID" Then
With sht.UsedRange
Set Rng = .Find(What:=Type)
Set Rng2 = .Find(What:=Pot)
If Not Rng Is Nothing And Not Rng2 Is Nothing Then
c = Rng.Column
locatie = Rng.Offset(0, -1)
afdeling = sht.Name
Pot = Rng.Offset(0, 1)
rij = .Cells(1, c - 1)
rijnr = Right(rij, 2)
Workbooks(1).Activate
With Sheets("Invulblad")
.Cells(6 + rijnr, 5) = locatie
.Cells(6 + rijnr, 6) = afdeling
.Cells(6 + rijnr, 7) = Potm
End With
Workbooks(2).Activate
Else
MsgBox "Niks gevonden"
End If
End With
End If
Next sht
Application.ScreenUpdating = True
Workbooks(1).Activate
End SubAlvast bedankt,
Michael
Laatst bewerkt:
