Unsure on how to loop SearchRange

M

mrkambo

New Member
Joined
May 7, 2017
Messages
23
The code below works fine and does exactly what i want it to do, however what is the best way to loop it

Sheet "New" has approx 3000 lines of data, the code below finds the first instance of SC which in this argument is 999, after its copied those values to "Database" how can i get it to continue searching through the rest of the lines on "New"

Code: 
Sheets(1).Copy After:=Workbooks(workbookname).Sheets("Database")
    Sheets(3).Name = ("New")
        LastrowD = Sheets("Database").Cells(Rows.Count, "J").End(xlUp).Row + 1
        lastrowN = Sheets("New").Cells(Rows.Count, "C").End(xlUp).Row
        lastrowb = Sheets("New").Cells(Rows.Count, "A").End(xlUp).Row
            ThisWorkbook.ActiveSheet.Cells.ClearFormats
            ThisWorkbook.ActiveSheet.Cells.HorizontalAlignment = xlLeft
            Lastrowa = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
            Workbooks(acname).Activate
            ActiveWorkbook.Close SaveChanges:=False
            
            SC = Sheets("Admin").Cells(2, 3)
                SearchString = SC
                Debug.Print SC
                    Set SearchRange = Sheets("New").Range("C7:C" & lastrowN).Find(SearchString)
                        If SearchRange Is Nothing Then
                        Debug.Print "cant find any data"
                            Else
                                Sheets("Database").Range("A" & LastrowD).Value = SearchRange.Offset(, -2).Value
                                Sheets("Database").Range("B" & LastrowD).Value = SearchRange.Offset(, -1).Value
                                Sheets("Database").Range("C" & LastrowD).Value = SearchRange.Offset(, 0).Value
                                Sheets("Database").Range("D" & LastrowD).Value = SearchRange.Offset(, 1).Value
                                Sheets("Database").Range("E" & LastrowD).Value = SearchRange.Offset(, 2).Value
                                Sheets("Database").Range("F" & LastrowD).Value = SearchRange.Offset(, 3).Value
                                Sheets("Database").Range("G" & LastrowD).Value = SearchRange.Offset(, 4).Value
                                Sheets("Database").Range("H" & LastrowD).Value = SearchRange.Offset(, 5).Value
                                Sheets("Database").Range("I" & LastrowD).Value = SearchRange.Offset(, 6).Value
                                Sheets("Database").Range("J" & LastrowD).Value = SearchRange.Offset(, 7).Value
                                Sheets("Database").Range("K" & LastrowD).Value = SearchRange.Offset(, 8).Value
                                Sheets("Database").Range("L" & LastrowD).Value = SearchRange.Offset(, 9).Value
                                Sheets("Database").Range("M" & LastrowD).Value = SearchRange.Offset(, 10).Value
                                Sheets("Database").Range("N" & LastrowD).Value = SearchRange.Offset(, 11).Value
                                Sheets("Database").Range("O" & LastrowD).Value = SearchRange.Offset(, 12).Value
                        End If

Any guidance would be appreciated
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
How about
Code: 
            SC = Sheets("Admin").Cells(2, 3)
                Debug.Print SC
                    If Application.CountIf(Sheets("New").Range("C7:C" & lastrowN), SC) = 0 Then
                        Debug.Print "cant find any data"
                    Else
                        With Sheets("New")
                            .Range("A7:O7").AutoFilter 3, SC
                            .AutoFilter.Range.Offset(1).Copy
                            Sheets("Database").Range("A" & LastrowD).PasteSpecial xlPasteValues
                            .AutoFilterMode False
                        End With
                    End If
 
Upvote 0
This is a way

Code: 
Sub test()
    Sheets(1).Copy After:=Workbooks(workbookname).Sheets("Database")
    Sheets(3).Name = ("New")
    LastrowD = Sheets("Database").Cells(Rows.Count, "C").End(xlUp).Row + 1
    lastrowN = Sheets("New").Cells(Rows.Count, "C").End(xlUp).Row
    lastrowb = Sheets("New").Cells(Rows.Count, "A").End(xlUp).Row
    ThisWorkbook.ActiveSheet.Cells.ClearFormats
    ThisWorkbook.ActiveSheet.Cells.HorizontalAlignment = xlLeft
    Lastrowa = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    Workbooks(acname).Activate
    ActiveWorkbook.Close SaveChanges:=False
'
    SC = Sheets("Admin").Cells(2, 3)
    SearchString = SC
'    Debug.Print SC
    Dim r As Range, cell As String
    Set r = Sheets("New").Range("C7:C" & lastrowN)
    Set SearchRange = r.Find(SearchString)
    If Not SearchRange Is Nothing Then
        cell = SearchRange.Address
        Do
            Sheets("Database").Range("A" & LastrowD).Value = SearchRange.Offset(, -2).Value
            Sheets("Database").Range("B" & LastrowD).Value = SearchRange.Offset(, -1).Value
            Sheets("Database").Range("C" & LastrowD).Value = SearchRange.Offset(, 0).Value
            Sheets("Database").Range("D" & LastrowD).Value = SearchRange.Offset(, 1).Value
            Sheets("Database").Range("E" & LastrowD).Value = SearchRange.Offset(, 2).Value
            Sheets("Database").Range("F" & LastrowD).Value = SearchRange.Offset(, 3).Value
            Sheets("Database").Range("G" & LastrowD).Value = SearchRange.Offset(, 4).Value
            Sheets("Database").Range("H" & LastrowD).Value = SearchRange.Offset(, 5).Value
            Sheets("Database").Range("I" & LastrowD).Value = SearchRange.Offset(, 6).Value
            Sheets("Database").Range("J" & LastrowD).Value = SearchRange.Offset(, 7).Value
            Sheets("Database").Range("K" & LastrowD).Value = SearchRange.Offset(, 8).Value
            Sheets("Database").Range("L" & LastrowD).Value = SearchRange.Offset(, 9).Value
            Sheets("Database").Range("M" & LastrowD).Value = SearchRange.Offset(, 10).Value
            Sheets("Database").Range("N" & LastrowD).Value = SearchRange.Offset(, 11).Value
            Sheets("Database").Range("O" & LastrowD).Value = SearchRange.Offset(, 12).Value
            Set SearchRange = r.FindNext(SearchRange)
            LastrowD = LastrowD + 1
        Loop While Not SearchRange Is Nothing And SearchRange.Address <> cell
    End If
End Sub


Or this:

Code: 
Sub test2()
    Sheets(1).Copy After:=Workbooks(workbookname).Sheets("Database")
    Sheets(3).Name = ("New")
    LastrowD = Sheets("Database").Cells(Rows.Count, "C").End(xlUp).Row + 1
    lastrowN = Sheets("New").Cells(Rows.Count, "C").End(xlUp).Row
    lastrowb = Sheets("New").Cells(Rows.Count, "A").End(xlUp).Row
    ThisWorkbook.ActiveSheet.Cells.ClearFormats
    ThisWorkbook.ActiveSheet.Cells.HorizontalAlignment = xlLeft
    Lastrowa = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    Workbooks(acname).Activate
    ActiveWorkbook.Close SaveChanges:=False
'
    SC = Sheets("Admin").Cells(2, 3)
    SearchString = SC
'    Debug.Print SC
    Sheets("New").Range("A6:O6").AutoFilter 3, SC
    Sheets("New").AutoFilter.Range.Offset(1).EntireRow.Copy Sheets("Database").Range("A" & LastrowD)
    Sheets("New").ShowAllData
End Sub
 
Upvote 0
Thanks for the solutions guys

went with Fluff, that was ultimately the way i wanted to do it, but couldn't quite work it out

:D
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Userform to worksheet values followed by 3 digits
Replies
2
Views
182
ipbr21054
I
A
  • Question
Cannot enter text in textbox on form
Replies
3
Views
124
Anthony47
A
C
  • Question
This is an Excel to Access porting issue - Is it possible to convert an Excel VBA FIND method to work correctly in and with Access's VBA ?
4 5 6
Replies
50
Views
1K
Trebor76
T
P
  • Solved
Userform textbox populated with listbox data how to edit
Replies
6
Views
479
pure vito
P
C
  • Question
Print from database
Replies
0
Views
118
Charlreena
C

Forum statistics

Threads
1,214,650
Messages
6,120,734
Members
448,987
Latest member
marion_davis

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top