Create loop and find second "0" in column VBA

ma.afsharpey
NewLounger
Posts: 8
Joined: 15 Nov 2017, 10:34

Create loop and find second "0" in column VBA

Post by ma.afsharpey »

Hi

I want to create loop for find second "0" value in column F

and when found "0" paste range in offset(1, -1) of the "0" Cell

and go to next second "0"
for example in this image:
photo_2017-11-15_11-45-41.jpg
I want to find yellow cell and copy red range to gray range
after this copy we have this image:
photo_2017-11-15_11-46-31.jpg
and we have new "0"
and again find new yellow cell and ...
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78230
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Create loop and find second "0" in column VBA

Post by HansV »

Welcome to Eileen's Lounge!

Try this macro:

Code: Select all

Sub FindZero()
    Dim c As Range
    Dim s As String
    Application.ScreenUpdating = False
    With Range("F7:F" & Rows.Count)
        Set c = .Find(What:=0, LookAt:=xlWhole)
        If Not c Is Nothing Then
            s = c.Address
            Do
                Set c = .FindNext(After:=c)
                If c.Address = s Then Exit Do
                Range("E2:E6").Copy Destination:=c.Offset(1, -1)
                Set c = .FindNext(After:=c.Offset(5, 0))
            Loop Until c.Address = s
        End If
    End With
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

ma.afsharpey
NewLounger
Posts: 8
Joined: 15 Nov 2017, 10:34

Re: Create loop and find second "0" in column VBA

Post by ma.afsharpey »

tanx my friend
it's not work :sad:
this is my excel file:
Apps.xlsm
when you open the file click this button:
1.PNG
and fill the box with this value and click ثبت
2.PNG
and you can see not work
really I don't know what should I do?
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78230
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Create loop and find second "0" in column VBA

Post by HansV »

There are several problems. In the screenshots in your previous reply, the yellow cells contain the second of two zeros below each other. In your sample workbook, there are no two zeros below each other.

Another problem is that you mix c and e as variables in the code. But before we tackle that: what exactly do you want to find? Any zero, or the second zero of two zeros below each other (as in the screenshots)?
Best wishes,
Hans

ma.afsharpey
NewLounger
Posts: 8
Joined: 15 Nov 2017, 10:34

Re: Create loop and find second "0" in column VBA

Post by ma.afsharpey »

I used e because I got error
I want Second zero od two zeros of each other

User avatar
HansV
Administrator
Posts: 78230
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Create loop and find second "0" in column VBA

Post by HansV »

But your sample workbook doesn't have those...
Best wishes,
Hans

ma.afsharpey
NewLounger
Posts: 8
Joined: 15 Nov 2017, 10:34

Re: Create loop and find second "0" in column VBA

Post by ma.afsharpey »

Sample have a zero on column f
When you fill the box in form
in column E paste new value and in column F we have a zero in each cell
I want to find second zero and paste range that I told and again we have zero
Do this loop to f20
is that possible?

User avatar
HansV
Administrator
Posts: 78230
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Create loop and find second "0" in column VBA

Post by HansV »

Try this. Please test on a copy of your worksheet.

Code: Select all

Private Sub save_btn_Click()
    Dim t As Integer
    Dim lastRow As Integer
    Dim lastRow1 As Integer
    Dim e As Range
    Dim s As String

    Application.ScreenUpdating = False

    If t_box.Value = "" Then
        MsgBox "ÊãÇãí ÝíáÏåÇ ÑÇ Ñ ˜äíÏ"
    Else
        t = t_box.Value + 4
        Range("A5").Value = 1
        Range("A6").Value = 2
        Range("A6").AutoFill Destination:=Range("A6:A" & t), Type:=xlFillSeries
    End If

    If t_box.Value > 100 Then
        MsgBox "Øæá ÏæÑå ˜ãÊÑ ÇÒ 100 ÈÇÔÏ"
    Else
        t_box.Value = ""
    End If

    Sheets("n=1").Range("b1") = r_box.Value
    Sheets("n=1").Range("d1") = d_box.Value
    Sheets("n=1").Range("f1") = q_box.Value
    Sheets("n=1").Range("h1") = n_box.Value
    Sheets("n=1").Range("f5") = pi_box.Value
    Sheets("n=1").Range("i6") = vi_box.Value

    lastRow = 5 + CInt(Range("i1").Value)
    Range("b1").Copy Destination:=Range("E6:E" & CStr(lastRow))

    lastRow1 = 6 + CInt(Range("i1").Value)
    Range("$k$1").Copy
    Range("E" & CStr(lastRow1)).PasteSpecial

    With Range("F7:F20")
        Set e = .Find(What:=0, LookIn:=xlValues, LookAt:=xlWhole)
        If Not e Is Nothing Then
            s = e.Address
            Do
                e.Offset(1, -1).Resize(5).Value = Range("E6:E10").Value
                Set e = .FindNext(After:=e.Offset(5, 0))
            Loop Until e.Address = s
        End If
    End With
    Application.ScreenUpdating = True
End Sub
Best wishes,
Hans

ma.afsharpey
NewLounger
Posts: 8
Joined: 15 Nov 2017, 10:34

Re: Create loop and find second "0" in column VBA

Post by ma.afsharpey »

thank you for spending time with me.
it's worked
but worked only value you saw
in this project maybe we have new range in E column for copy
for example instead Range("E6:E10") , maybe we have Range("E6:E15") and copy new value to offset(1, -1)
change range come from new data input from form
I did little change in code but didn't work:

Code: Select all

Private Sub save_btn_Click()
 Dim t As Integer
    Dim lastRow As Integer
    Dim lastRow1 As Integer
    Dim e As Range
    Dim s As String

    Application.ScreenUpdating = False

    If t_box.Value = "" Then
        MsgBox "E?C?? ???I?C ?C ?? ???I"
    Else
        t = t_box.Value + 4
        Range("A5").Value = 1
        Range("A6").Value = 2
        Range("A6").AutoFill Destination:=Range("A6:A" & t), Type:=xlFillSeries
    End If

    If t_box.Value > 100 Then
        MsgBox "??? I??? ??E? C? 100 ECOI"
    Else
        t_box.Value = ""
    End If

    Sheets("n=1").Range("b1") = r_box.Value
    Sheets("n=1").Range("d1") = d_box.Value
    Sheets("n=1").Range("f1") = q_box.Value
    Sheets("n=1").Range("h1") = n_box.Value
    Sheets("n=1").Range("f5") = pi_box.Value
    Sheets("n=1").Range("i6") = vi_box.Value

    lastRow = 5 + CInt(Range("i1").Value)
    Range("b1").Copy Destination:=Range("E6:E" & CStr(lastRow))

    lastRow1 = 6 + CInt(Range("i1").Value)
    Range("$k$1").Copy
    Range("E" & CStr(lastRow1)).PasteSpecial

    With Range("F7:F20")
        Set e = .Find(What:=0, LookIn:=xlValues, LookAt:=xlWhole)
        If Not e Is Nothing Then
            s = e.Address
            Do
                e.Offset(1, -1).Resize(5).Value = Range("E6:E" & CStr(lastRow1)).Value
                Set e = .FindNext(After:=e.Offset(5, 0))
            Loop Until e.Address = s
        End If
    End With
    Application.ScreenUpdating = True

End Sub

User avatar
HansV
Administrator
Posts: 78230
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Create loop and find second "0" in column VBA

Post by HansV »

Ho can we determine which range to copy?
Best wishes,
Hans

ma.afsharpey
NewLounger
Posts: 8
Joined: 15 Nov 2017, 10:34

Re: Create loop and find second "0" in column VBA

Post by ma.afsharpey »

When you change value in form the range maybe change
E6:E & CStr(lastRow1)

User avatar
HansV
Administrator
Posts: 78230
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Create loop and find second "0" in column VBA

Post by HansV »

What goes wrong if you try that?
Best wishes,
Hans

ma.afsharpey
NewLounger
Posts: 8
Joined: 15 Nov 2017, 10:34

Re: Create loop and find second "0" in column VBA

Post by ma.afsharpey »

after 3rd (second zero) didn’t work

User avatar
HansV
Administrator
Posts: 78230
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Create loop and find second "0" in column VBA

Post by HansV »

Does this do what you want?

Code: Select all

    With Range("F7:F20")
        Set e = .Find(What:=0, LookIn:=xlValues, LookAt:=xlWhole)
        If Not e Is Nothing Then
            s = e.Address
            Do
                e.Offset(1, -1).Resize(lastRow1 - 5).Value = Range("E6:E" & CStr(lastRow1)).Value
                Set e = .FindNext(After:=e.Offset(lastRow1 - 5, 0))
            Loop Until e.Address = s
        End If
    End With
Best wishes,
Hans

ma.afsharpey
NewLounger
Posts: 8
Joined: 15 Nov 2017, 10:34

Re: Create loop and find second "0" in column VBA

Post by ma.afsharpey »

yessss
tannnx
it's worked
when in n_box fill with 3 or 5 this "Set e = .FindNext(After:=e.Offset(lastRow1 - 5, 0))" have error

User avatar
HansV
Administrator
Posts: 78230
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Create loop and find second "0" in column VBA

Post by HansV »

Insert the following line above the line "Set e = .FindNext(After:=e.Offset(lastRow1 - 5, 0))":

Code: Select all

                If e.Offset(lastRow1 - 5, 0).Row > 20 Then Exit Do
This checks that we exit the loop if we would have to search below row 20.
Best wishes,
Hans