VBA: FindString needs to be more efficient

[gd6noob]

Hi everyone,

I have some code but I think it can be better coded.

Basically I'm looking to find string value "Bereavement", "Provincial Leave", "Medical Waiver" and if not found it will paste the missing string into the next blank cell. I have the FindString= wirtten 3 times for all 3 string values and it is probably not the best way, seeing if someone has a better option. The range would be A1:D1, as I have other data in other columns.

APT v5.0.xlsb
	A	B	C	D
1	Row Labels	Bereavement	Provincial Leave	Medical Waiver
2	1234	0	Not Used
3	1234	0	Not Used
4	1234	Not Used	7
5	1234	Not Used	9
6	1234	Not Used	7
PL Balances 1

Sub Find_First()
Dim FindString As String
Dim Rng As Range
Dim LastColumn As Variant
Dim sht As Worksheet

Set sht = ThisWorkbook.Sheets("PL Balances 1")

FindString = "Medical Waiver"
    With Sheets("PL Balances 1").Range("A1:D1")
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then

        Else
            With sht
                LastColumn = .Range("A1").End(xlToRight).Column
            End With
                sht.Cells(1, LastColumn).Offset(0, 1).Value = "Medical Waiver"
        End If
    End With

Thank you.

 

[DanteAmor]

Try this:

Sub find_string()
  Dim arr As Variant
  Dim f As Range
  Dim i As Long
 
  arr = Array("Bereavement", "Provincial Leave", "Medical Waiver")
  For i = 0 To UBound(arr)
    With Sheets("PL Balances 1")
      Set f = .Range("A1:D1").Find(arr(i), , xlValues, xlWhole, , , False)
      If f Is Nothing Then
        .Cells(1, Columns.Count).End(1)(1, 2).Value = arr(i)
      End If
    End With
  Next
End Sub

---
If headers always go in cells B1, C1, and D1, then:

Sub macro()
  Range("B1:D1").Value = Array("Bereavement", "Provincial Leave", "Medical Waiver")
End Sub

 

[gd6noob]

Try this:

Sub find_string()
  Dim arr As Variant
  Dim f As Range
  Dim i As Long
 
  arr = Array("Bereavement", "Provincial Leave", "Medical Waiver")
  For i = 0 To UBound(arr)
    With Sheets("PL Balances 1")
      Set f = .Range("A1:D1").Find(arr(i), , xlValues, xlWhole, , , False)
      If f Is Nothing Then
        .Cells(1, Columns.Count).End(1)(1, 2).Value = arr(i)
      End If
    End With
  Next
End Sub

---
If headers always go in cells B1, C1, and D1, then:

Sub macro()
  Range("B1:D1").Value = Array("Bereavement", "Provincial Leave", "Medical Waiver")
End Sub

Thank you very much for your help.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.