Solved: Modify Code To Offset by 2 To Destination Sheet

[Barryj]

I have been trying to modify my code to offset from the last row of data in the destination sheet by 2 rows.

I have had no luck altering the code after searching the forum, I know it will be simple in the end but I just seem to be missing where I am going wrong.

The Daily Defaulter Board is the destination sheet.

Thanks for any assistance

Private Sub commandbutton3_Click()
With Sheets("Daily Defaulter Board").Unprotect("1")
Set rng = Range([B4], [V65536].End(xlUp))

Dim r As Range, grade, c As Range
Dim i As Integer, sn, x As Range
grade = Array("N")
sn = Array("Daily Defaulter Board")
Application.ScreenUpdating = False
For i = LBound(sn) To UBound(sn)
Next
With Sheets("Defaulter Comments")
For Each r In .Range("a4", .Range("a65536").End(xlUp))
If r.Offset(0, 1).Value = "" Then GoTo SkipIt1
For i = LBound(grade) To UBound(grade)
If r.Value = grade(i) Then
Set x = Sheets(sn(i)).Range("a65536").End(xlUp).Offset(1)
x.Value = r.Offset(, 1).Value
x.Offset(, 1).Resize(, 1).Value = r.Offset(, 2).Resize(, 1).Value
x.Offset(, 2).Value = r.Offset(, 1).Value

Exit For
End If
SkipIt1:
Next
Next


Application.ScreenUpdating = True
With Sheets("Daily Defaulter Board").Unprotect("1")
End With
End With
End With
End Sub

[SamT]

Cleaned your code. :dunno if it will work

Option Explicit


Private Sub SamT_Click()

Dim i As Integer
Const Grade As String = "N"
Dim R As Range, X As Range
Dim DDB As Worksheet, Ds As Worksheet
Set DDB = Sheets("Daily Defaulter Board")
Set Ds = Sheets("Defaulter Comments")

Application.ScreenUpdating = False

With DDB
.Unprotect ("1")

For Each R In Ds.Range("a4", .Cells(Rows.Count, 1).End(xlUp))
Set R = R.Offset(, 1) 'Do it once and fuggidaboudit
If R.Value = Grade Then
'Next Cell in DDB
Set X = DDB.Cells(Rows.Count, 1).End(xlUp).Offset(1)
'Set 3 Column Values from DS to DDB
X.Resize(, 2).Value = R.Resize(, 2).Value

'Once the first match is found, clean up and exit sub
Exit For 'I think you want to get rid of this line
End If
Next

.Protect ("1")
End With

Application.ScreenUpdating = True
End Sub

[Barryj]

Thanks for your help there SamT, the code is transfering the data between the sheets fine but is not offsetting, data is still ending up under the last row.

Tried altering this line Set R = R.Offset(, 1) to 2 then 3 but still the same result as before.

Any thoughts

Thanks

[SamT]

Set X = blah, blah, blah.OffSet = (, 2)

Hard to remember what X and R refer to? :banghead:

Use Ctrl+H to replace R with SrcRng and X with DestRng, and you'll never again forget. :thumb

[Barryj]

I have modified the code to the below but it is still not offsetting as required, all else is ok, have I missed somthing with what was suggested.

Thanks

Private Sub commandbutton3_Click()
Dim i As Integer
Const Grade As String = "N"
Dim R As SrcRng, X As DestRng
Dim DDB As Worksheet, Ds As Worksheet
Set DDB = Sheets("Daily Defaulter Board")
Set Ds = Sheets("Defaulter Comments")

Application.ScreenUpdating = False

With DDB
.Unprotect ("1")

For Each R In Ds.Range("a4", .Cells(Rows.Count, 1).End(xlUp))
Set R = R.Offset(, 1) 'Do it once and fuggidaboudit
If R.Value = Grade Then
'Next Cell in DDB
Set X = DDB.Cells(Rows.Count, 1).End(xlUp).Offset(, 2)
'Set 3 Column Values from DS to DDB
X.Resize(, 2).Value = R.Resize(, 2).Value

'Once the first match is found, clean up and exit sub
Exit For 'I think you want to get rid of this line
End If
Next

.Protect ("1")
End With

Application.ScreenUpdating = True
End Sub

[SamT]

:rotlaugh:

Always use Option Explicit at the top of your code page.
Option Explicit

Private Sub commandbutton3_Click()
Dim i As Integer
Const Grade As String = "N"
Dim SrcRng As Range, DestRng As Range
Dim DDB As Worksheet, Ds As Worksheet
Set DDB = Sheets("Daily Defaulter Board")
Set Ds = Sheets("Defaulter Comments")

Application.ScreenUpdating = False

With DDB
.Unprotect ("1")

For Each SrcRng In Ds.Range("A4", .Cells(Rows.Count, 1).End(xlUp))
Set SrcRng = SrcRng.Offset(, 1) 'Do it once and fuggidaboudit
If SrcRng.Value = Grade Then
'Next Cell in DDB
Set DestRng = DDB.Cells(Rows.Count, 1).End(xlUp).Offset(, 2)
'Set 3 Column Values from DS to DDB
DestRng.Resize(, 2).Value = SrcRng.Resize(, 2).Value

'Once the first match is found, clean up and exit sub
Exit For 'I think you want to get rid of this line
End If
Next

.Protect ("1")
End With

Application.ScreenUpdating = True
End Sub


Be sure to edit comments so they reflect any changes you make to your code.

Best Practice is to go to VBA editor Menu >> Tools >> Options >> Editor Tab and check every option in the Code Settings group. Set The Auto Indent and Tab Width as you like, I use TW = 2.

I also check Full Module View and Procedure Separator, YMMV.

On the General Tab, Error Trapping group, I check Break On Unhandled Errors and Compile On Demand, again, YMMV

The Editor Format Tab lets you change the colors used for for different code elements.

http://www.vbaexpress.com/forum/attachment.php?attachmentid=10069&stc=1&d=1369753100

[Barryj]

Thanks for your assistance with this SamT have copied the code into the sheet module but getting the same result, no offset in the destination sheet.

Any thoughts?

Thanks

[SamT]

Thanks for your assistance with this SamT have copied the code into the sheet module but getting the same result, no offset in the destination sheet.

Any thoughts?

Thanks

Are you taking the time to study and compare the code I offer with the code you wrote?

Or, are you just pasting my offerings in?

:friends:

[snb]

Private Sub commandbutton3_Click()
Application.ScreenUpdating = False

With Sheets("Daily Defaulter Board")
.Unprotect ("1")
with Sheets("Defaulter Comments").cells(1).currentregion.resize(,2)
.autofilter 1,"N"
.offset(1).copy Sheets("Daily Defaulter Board").cells(rows.count,1).end(xlup).offset(2)
.autofilter
end with
.Protect ("1")
End With

Application.ScreenUpdating = True
End Sub



NB. Remove 'Option Explicit' before running this macro.

[Barryj]

Thankyou both SamT and snb for your time on this, I will mark this as solved as both are giving me the required result, again thankyou for your assistance.