FindNext loop until next blank cell

[Surftahiti9386]

Hello,

I am stuck on a simple idea but yet the code for it might not be that simple...
I am a beginner at coding in VBA, and I am trying to create a sub that selects and paste the values of all the cells in a column that contains today's date when you close the sheet.
Right now I managed to make it work for only two consecutive cells but nothing more.
I need to use a Loop to select all the cells until there is a blank cell, but I cannot do it on my own.

All the dates are in the B column in the sheet I use for testing.
Here's the code that works but only for the first two cells of the array.
I need to insert a "Do Loop Until" into this code...

Thank you.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim fR As Range
Dim fF As Range
With Worksheets("Feuil1").Range("B1:B10")
Set fR = .Find(what:=Date, after:=.Range("A5"), LookIn:=xlValues, lookat:=xlWhole)
If Not fR Is Nothing Then
Set fF = .FindNext(fR)
Range(fR, fF).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End Sub

 

[Joe4]

Welcome to the Board!

I think it would be beneficial if you could post an example of your data, along with your expected output. MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.

Also, please use Code Tags when posting your VBA code for nicely formatted code that can easily be read and copied.
See: How to Post Your VBA Code

 

[Surftahiti9386]

Thank you for the tips...

Hers is the code :

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim fR As Range
Dim fF As Range
With Worksheets("Feuil1").Range("B1:B10")
Set fR = .Find(what:=Date, after:=.Range("A5"), LookIn:=xlValues, lookat:=xlWhole)
If Not fR Is Nothing Then
Set fF = .FindNext(fR)
Range(fR, fF).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
End Sub

And the sheet looks like this :

 

[Joe4]

One issue is you are missing the "End If" line in your code to end your IF block.

In a nutshell, are you just wanting to convert all the formulas in column B to hard-coded values?
If so, no loops are needed, and you should simply be able to use this:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim lr As Long

    With Worksheets("Feuil1")
        lr = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Range("B1:B" & lr).Value = .Range("B1:B" & lr).Value
    End With
        
End Sub

 

[Surftahiti9386]

One issue is you are missing the "End If" line in your code to end your IF block.

In a nutshell, are you just wanting to convert all the formulas in column B to hard-coded values?
If so, no loops are needed, and you should simply be able to use this:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim lr As Long

    With Worksheets("Feuil1")
        lr = .Cells(.Rows.Count, "B").End(xlUp).Row
        .Range("B1:B" & lr).Value = .Range("B1:B" & lr).Value
    End With
       
End Sub

Alright, thanks for the End if !

I need only the dates of today to be copied as values when I exit the file, but without touching the formulas underneath the cells with the date.
(As you can see in my formula, when I type in column A the date of today appears, and this is coded for the entire B column, so it's an empty cell when nothing is in column A. But if I exit the file and come back the next day all the dates are updated, and I don't want this !!)

 

[Joe4]

OK, try this version then:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim lr As Long
    Dim r As Long

    With Worksheets("Feuil1")
        Application.ScreenUpdating = False
        lr = .Cells(.Rows.Count, "B").End(xlUp).Row
        For r = 1 To lr
            If .Cells(r, "B").Value = Date Then
                .Cells(r, "B").Value = .Cells(r, "B").Value
            End If
        Next r
        Application.ScreenUpdating = True
    End With
        
End Sub