Offset not working correctly

Francois084

New Member
Joined
Jun 23, 2022
Messages
10
Office Version
  1. 2019
Platform
  1. Windows
Hi

I'm having trouble with my offset
I used my previous code and changed it so that it look for a specific word and search over multiple worksheets
It does find the word and copies it over to the new sheet.
but when it find the 2nd one it overwrites the previous line on the new sheet

Thank you for helping

VBA Code:
Sub OtherSearchString()

Dim iIndex As Integer
Dim ws As Excel.Worksheet
Dim lr As Long
Dim r As Long
Dim C As Range
Dim Target As Worksheet
b = 0
Set Target = ActiveWorkbook.Worksheets("Supp or Dept")

    For iIndex = 1 To ActiveWorkbook.Worksheets.Count
        Set ws = Worksheets(iIndex)
        ws.Activate
        '   Find last row in column E on Source sheet
    lr = ws.Cells(Rows.Count, "C").End(xlUp).Row

'   Loop through each row in column E backwards
    For r = lr To 1 Step -1
'       Build "c" range
        Set C = ws.Range("C" & r)
'       Proceed with rest of your code
        If C Like "*SUPP*" Then
            C.EntireRow.copy
            Target.Range("A" & Rows.Count).End(xlDown).Offset(1).PasteSpecial
            C.EntireRow.Delete
        ElseIf C Like "*DEPT*" Then
            C.EntireRow.copy
            b = Target.Range("A" & Rows.Count).End(xlUp).Offset(3).PasteSpecial
            b = b + 1
            C.EntireRow.Delete
            
        End If
    Next r
Next iIndex
End Sub
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
I am confused by this line of code:
b = Target.Range("A" & Rows.Count).End(xlUp).Offset(3).PasteSpecial
What does the variable "b" represent? Why Offset(3) instead of Offset(1)?
It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of one of your sheets. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).
 
Upvote 0
Sorry

I was trying different things to get to the next line
here is the clean code

VBA Code:
Sub OtherSearchString()

Dim iIndex As Integer
Dim ws As Excel.Worksheet
Dim lr As Long
Dim r As Long
Dim C As Range
Dim Target As Worksheet
Set Target = ActiveWorkbook.Worksheets("Supp or Dept")

    For iIndex = 1 To ActiveWorkbook.Worksheets.Count
        Set ws = Worksheets(iIndex)
        ws.Activate
        '   Find last row in column E on Source sheet
    lr = ws.Cells(Rows.Count, "C").End(xlUp).Row

'   Loop through each row in column E backwards
    For r = lr To 1 Step -1
'       Build "c" range
        Set C = ws.Range("C" & r)
'       Proceed with rest of your code
        If C Like "*SUPP*" Then
            C.EntireRow.copy
            Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
            C.EntireRow.Delete
        ElseIf C Like "*DEPT*" Then
            C.EntireRow.copy
            Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
            C.EntireRow.Delete
            
        End If
    Next r
Next iIndex
End Sub
 
Upvote 0
This macro assumes that you have headers in row 1 and your data starts in row 2.
VBA Code:
Sub OtherSearchString()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet
    Set desWS = Sheets("Supp or Dept")
    For Each ws In Sheets
        If ws.Name <> "Supp or Dept" Then
            With ws
                .Range("A1").AutoFilter 3, Criteria1:="*SUPP*", Operator:=xlOr, Criteria2:="*DEPT*"
                .AutoFilter.Range.Offset(1).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
                .AutoFilter.Range.Offset(1).EntireRow.Delete
                .Range("A1").AutoFilter
            End With
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi. it works but it pulls in extra data

Item 1
Item 2
Item 3
Item 4
Item 5
SUPPLIER 1
SUPPLIER 2
SUPPLIER 3
SUPPLIER 4
Item 2
Item 3
Item 4
Item 6
Item 1
Item 2
Item 3
Item 4
Item 5
SUPPLIER 1
SUPPLIER 2
SUPPLIER 3
SUPPLIER 4
Item 2
Item 3
Item 4
Item 6
 
Upvote 0
Please refer to Post #2 to attach a screen shot or file.
 
Upvote 0
1656082681318.png
 
Upvote 0
It is hard to work with a picture. Please use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of the entire sheet with the row numbers and column letters visible or upload a copy of your file to a free site such as www.box.com or www.dropbox.com and post the link to the file.
 
Upvote 0
BigPromo.xlsx
ABC
1
27031170096009675630035Item 1
31986916009695583441Item 2
41621596009695581867Item 3
57017940026005111002909Item 4
62577306009516204630Item 5
7SUPPLIER 1
8SUPPLIER 2
9SUPPLIER 3
10SUPPLIER 4
111986916009695583441Item 2
121621596009695581867Item 3
137017940026005111002909Item 4
141646956009802884294Item 6
157031170096009675630035Item 1
161986916009695583441Item 2
171621596009695581867Item 3
187017940026005111002909Item 4
192577306009516204630Item 5
20SUPPLIER 1
21SUPPLIER 2
22SUPPLIER 3
23SUPPLIER 4
241986916009695583441Item 2
251621596009695581867Item 3
267017940026005111002909Item 4
271646956009802884294Item 6
28
29
Supp or Dept
 
Upvote 0
The Sub SearchString() work 100%. copies every line to the new sheet, new line
but the Sub OtherSearchString() does not make a new line on the new sheet

VBA Code:
Sub SearchString()

Dim lr As Long
Dim r As Long
Dim C As Range
Dim Source As Worksheet
Dim Target As Worksheet
Dim Target1 As Worksheet

Set Source = ActiveWorkbook.Worksheets("Master List")
Set Target = ActiveWorkbook.Worksheets("Group")
  
'   Find last row in column E on Source sheet
    lr = Source.Cells(Rows.Count, "E").End(xlUp).Row

'   Loop through each row in column E backwards
    For r = lr To 1 Step -1
'       Build "c" range
        Set C = Source.Range("E" & r)
'       Proceed with rest of your code
        If C Like "*FOR*" Then
            C.EntireRow.copy
            Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            C.EntireRow.Delete
        ElseIf C Like "*+*" Then
            C.EntireRow.copy
            Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            C.EntireRow.Delete
        End If
    Next r
    Columns("A:A").NumberFormat = "#"
    Columns("B:B").NumberFormat = "#"
Sheets.Add.Name = "Supp or Dept"
 Worksheets("Supp or Dept").Move After:=Worksheets(Worksheets.Count)
Call OtherSearchString
End Sub
Sub OtherSearchString()

Dim lr As Long
Dim r As Long
Dim C As Range
Dim Source As Worksheet
Dim Target As Worksheet
Dim Target1 As Worksheet

Set Source = ActiveWorkbook.Worksheets("Master List")
Set Target = ActiveWorkbook.Worksheets("Supp or Dept")
  
'   Find last row in column E on Source sheet
    lr = Source.Cells(Rows.Count, "C").End(xlUp).Row

'   Loop through each row in column E backwards
    For r = lr To 1 Step -1
'       Build "c" range
        Set C = Source.Range("C" & r)
'       Proceed with rest of your code
        If C Like "*SUPP*" Then
            C.EntireRow.copy
            Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            C.EntireRow.Delete
        ElseIf C Like "*DEPT*" Then
            C.EntireRow.copy
            Target.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
            C.EntireRow.Delete
        End If
    Next r
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,524
Messages
6,114,117
Members
448,549
Latest member
brianhfield

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