VBA Excel Loop for Multiple occurrence of a Value

[KAHHAR]

Create Loop for Copy data for Multiple occurrence of Sheets("Result").Range("D1").Text

Private Sub CommandButton1_Click()
Dim celldesav As Range
Dim rdesav As Range
Dim searchdesav As String

Set rdesav = Sheets("List").Columns("A:A")
searchdesav = Sheets("Result").Range("D1").Text
Set celldesav = rdesav.Find(What:=searchdesav, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)

Sheets("List").Range(celldesav, celldesav.Offset(-4, 0)).Copy
Sheets("Result").Range("A1").PasteSpecial Paste:=xlPasteValues
Sheets("List").Range(celldesav, celldesav.Offset(1, 0)).Copy
Sheets("Result").Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End Sub

Need a quick help please

 

[fadee2]

Hi Kahhar,

Welcome to the board,

I would suggest using findnext in vba for searching multiple occurrences of a string, in a data set.
Complete how to is available here.

hth...

 

[KAHHAR]

Hi Kahhar,

Welcome to the board,

I would suggest using findnext in vba for searching multiple occurrences of a string, in a data set.
Complete how to is available here.

hth...

I'M new in codding. could you please describe me about looping my code.

 

[mart37]

Private Sub CommandButton1_Click()
Dim celldesav As Range
Dim rdesav As Range
Dim searchdesav As String

Set rdesav = Sheets("List").Columns("A:A")
searchdesav = Sheets("Result").Range("D1").Text
Set celldesav = rdesav.Find(What:=searchdesav, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)

If Not celldesav Is Nothing Then
    FirstAddress = celldesav.Address
    Do
        Sheets("List").Range(celldesav.Offset(1, 0), celldesav.Offset(-4, 0)).Copy
        Sheets("Result").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        Set celldesav = rdesav.FindNext(celldesav)
        if celldesav Is Nothing Then Goto DoneFinding
    Loop While celldesav.Address <> FirstAddress
DoneFinding:
End IF
End Sub

 

[KAHHAR]

thank@

mart37 it's working​

 

[KAHHAR]

Private Sub CommandButton1_Click()
Dim celldesav As Range
Dim rdesav As Range
Dim searchdesav As String

Set rdesav = Sheets("List").Columns("A:A")
searchdesav = Sheets("Result").Range("D1").Text
Set celldesav = rdesav.Find(What:=searchdesav, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)

If Not celldesav Is Nothing Then
    FirstAddress = celldesav.Address
    Do
        Sheets("List").Range(celldesav.Offset(1, 0), celldesav.Offset(-4, 0)).Copy
        Sheets("Result").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        Set celldesav = rdesav.FindNext(celldesav)
        if celldesav Is Nothing Then Goto DoneFinding
    Loop While celldesav.Address <> FirstAddress
DoneFinding:
End IF
End Sub

Can i use Greater then zero value for search instead of "Sheets("Result").Range("D1").Text"

 

[mart37]

What do you mean? Greater than zero is almost everything.
Can you give an example what you want?

 

[KAHHAR]

What do you mean? Greater than zero is almost everything.
Can you give an example what you want?

Sorry to bother you. Your Code is working perfectly.