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

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
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

T
  • Solved
Search for text and highlight row
Replies
5
Views
307
Joe4
Joe4
I
  • Solved
After code is run i am unable to use keyboard arrows to move from selected cell
Replies
3
Views
179
ipbr21054
I
PIsabel
  • Question Question
Change prices
Replies
3
Views
87
smozgur
smozgur
B
  • Solved
Use Sheet1:D5 to find matching cell in Sheet2 Column A:A, and select cell (or row)
Replies
1
Views
429
brianv
B
C
  • Question Question
Using pattern searches with a variable to find the correct values
2
Replies
10
Views
265
chazrab
C

Forum statistics

Threads
1,224,819
Messages
6,181,153
Members
453,021
Latest member
Justyna P

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