Extract the date and name and repeat it along the column

[sofas]

Hello. I want help extracting the name of the product from column C, provided there is the word "Restaurant*") The date from the H column
And it is repeated along the column down to the second condition so that it is extracted and repeated in the same way. The problem is that I used this code, it does a good job, but it is very slow, because the file consists of hundreds of rows and invoices, and it always extracts names and dates from the first invoice, even though it is not empty. Can I modify it and help me in another code that does the same task, but it starts when it finds the invoice is empty

Sub Remplir_tout_all()
Dim nmax&, a$(), derlig&, tablo, i&, n&, C As Range, dat$, h&
Dim rng As Range
Set ST = Sheet1
 lr = ST.Range("a" & Rows.Count).End(xlUp).Row
With Sheet1
    nmax = Application.CountIf(.[c:c], "Restaurant*")
    ReDim a(nmax)
    derlig = .Range("C" & .Rows.Count).End(xlUp).Row + 1
    a(nmax) = "c" & derlig
    tablo = .Range("c1:c" & derlig)
    For i = 1 To derlig
        If Trim(tablo(i, 1)) Like "Restaurant*" Then a(n) = "c" & i: n = n + 1
    Next i
    Application.ScreenUpdating = False
     Range("a4:b" & lr).ClearContents
    .[A:B].HorizontalAlignment = xlCenter
    For n = 0 To UBound(a) - 1
        Set C = .Range(a(n))
        dat = Mid(Trim(C(5, 6)), 11, 10)
        h = .Range(a(n + 1)).Row - 1 - C(5).Row
        If h > 0 Then
            If IsDate(dat) Then C(6, -1).Resize(h) = CDate(dat)
            C(6, -0).Resize(h) = C(2)
        End If
    Next n
End With
End Sub

 

[sofas]

Yes, after trying the attached file, it works fine. Now the problem is when I add the heading headers for the table in row 2 I get an error message. I do not know the reason

I found out where the problem is. When there is the word restaurants in the headers of the titles, the message is possible, and we start the code from row 3

 

[Legacy 143009]

Then modify like this:

Sub test()
  Dim lRow As Long, ws As Worksheet, C As Range, j As Long, i As Long
  Set ws = Worksheets("Sheet1")
  lRow = ws.Cells(Rows.Count, 8).End(xlUp).Row
  Set rSearch = ws.Range("C2:H" & lRow)
  Application.ScreenUpdating = False
  With rSearch
  Set C = .Find(what:="Restaurant", lookat:=xlPart, MatchCase:=False)
  i = C.Row + 5
  Do While j < lRow
    Set C = .FindNext(C)
    j = IIf(C.Row < j, lRow, C.Row - 1)
    ws.Range("A" & i & ":A" & j) = rSearch(i - 5, 1)
    ws.Range("B" & i & ":B" & j) = CDate(Right(Trim(rSearch(i - 2, 6)), 10))
    i = j + 6
  Loop
  End With
  Application.ScreenUpdating = True
End Sub

 

[sofas]

Then modify like this:

Sub test()
  Dim lRow As Long, ws As Worksheet, C As Range, j As Long, i As Long
  Set ws = Worksheets("Sheet1")
  lRow = ws.Cells(Rows.Count, 8).End(xlUp).Row
  Set rSearch = ws.Range("C2:H" & lRow)
  Application.ScreenUpdating = False
  With rSearch
  Set C = .Find(what:="Restaurant", lookat:=xlPart, MatchCase:=False)
  i = C.Row + 5
  Do While j < lRow
    Set C = .FindNext(C)
    j = IIf(C.Row < j, lRow, C.Row - 1)
    ws.Range("A" & i & ":A" & j) = rSearch(i - 5, 1)
    ws.Range("B" & i & ":B" & j) = CDate(Right(Trim(rSearch(i - 2, 6)), 10))
    i = j + 6
  Loop
  End With
  Application.ScreenUpdating = True
End Sub

Thank you. Done successfully. At least we saved 8 seconds. Thank you for following up

 

[Legacy 143009]

I am glad it did shave a little bit. Thanks for the feedback

 

[sofas]

I am glad it did shave a little bit. Thanks for the feedback

Hello. I would like to thank you for this most wonderful code. I just want to tell you a simple note that I discovered quite late. Is that the code fetch the date from the right side and I want the date on the left. What do i change in this line to get the result
Example:
from date 12/02/2022 to date 04/03/2022
Here I want to get 12/02/2922

ws.Range("B" & i & ":B" & j) = CDate(Right(Trim(rSearch(i - 2, 6)), 10))

 

[sofas]

Hello. I would like to thank you for this most wonderful code. I just want to tell you a simple note that I discovered quite late. Is that the code fetch the date from the right side and I want the date on the left. What do i change in this line to get the result
Example:
from date 12/02/2022 to date 04/03/2022
Here I want to get 12/02/2022

ws.Range("B" & i & ":B" & j) = CDate(Right(Trim(rSearch(i - 2, 6)), 10))

 

[Legacy 143009]

You can change this piece of code:

CDate(Right(Trim(rSearch(i - 2, 6)), 10))

To this

CDate(Mid(Trim(rSearch(i - 2, 6)), 11, 10))