PDA

View Full Version : Solved: Autofill formula VBA needed



georgedaws
03-20-2011, 08:27 AM
Hi,

I have this code that works fine
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, i As Long
On Error Resume Next
Set c = Intersect(Target, Columns(3))
If c Is Nothing Then Exit Sub
If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
i = c.Row
Application.EnableEvents = False
Range("A" & i - 1 & ":B" & i - 1).Copy Range("A" & i & ":B" & i)
Application.EnableEvents = True
On Error GoTo 0
End Sub

But I need this code to work alongside the same code but with a different target column and range as below

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, i As Long
On Error Resume Next
Set c = Intersect(Target, Columns(16))
If c Is Nothing Then Exit Sub
If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
i = c.Row
Application.EnableEvents = False
Range("Q" & i - 1 ).Copy Range("Q" & i &)
Application.EnableEvents = True
On Error GoTo 0
End Sub

To make it slightly more complicated, I already have this code existing as a worksheet change

Private Sub Worksheet_Change(ByVal Target As Range)
Const sWSPWD As String = ""
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("F3:F10000")) Is Nothing Then
Me.Unprotect ""
If Target.Offset(, 2) = "" Then Target.Offset(, 2) = Date
Me.Protect ""
ElseIf Not Intersect(Target, Me.Range("L3:L10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
ElseIf Not Intersect(Target, Me.Range("O3:O10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
ElseIf Not Intersect(Target, Me.Range("T3:T10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
End Sub


So I just need all three to work in harmony.

I have tried inserting "end If" and "else if" at differnt points I thought they should go, but my knowledge is very limited.

I need vba to insert formula to next row because of the amount of rows that will be used.

If it can't be done and you read this, please just let me know.


Thank you

mdmackillop
03-20-2011, 11:20 AM
Something like this. You can delete some of the checking if you do it all in the initial change macro.

Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 3
Call Macro1(Target)
Case 16
Call Macro2(Target)
Case Else
Call Macro3(Target)
End Select

End Sub

Private Sub Macro1(ByVal Target As Range)
Dim c As Range, i As Long
On Error Resume Next
Set c = Intersect(Target, Columns(3))
If c Is Nothing Then Exit Sub
If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
i = c.Row
Application.EnableEvents = False
Range("A" & i - 1 & ":B" & i - 1).Copy Range("A" & i & ":B" & i)
Application.EnableEvents = True
On Error GoTo 0
End Sub


Private Sub Macro2(ByVal Target As Range)
Dim c As Range, i As Long
On Error Resume Next
Set c = Intersect(Target, Columns(16))
If c Is Nothing Then Exit Sub
If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
i = c.Row
Application.EnableEvents = False
Range("Q" & i - 1).Copy Range("Q" & i) '<===Check this line
Application.EnableEvents = True
On Error GoTo 0
End Sub

Private Sub Macro3(ByVal Target As Range)
Const sWSPWD As String = ""
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("F3:F10000")) Is Nothing Then
Me.Unprotect ""
If Target.Offset(, 2) = "" Then Target.Offset(, 2) = Date
Me.Protect ""
ElseIf Not Intersect(Target, Me.Range("L3:L10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
ElseIf Not Intersect(Target, Me.Range("O3:O10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
ElseIf Not Intersect(Target, Me.Range("T3:T10000")) Is Nothing Then
ActiveSheet.Unprotect ""
If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
ActiveSheet.Protect ""
End If
End Sub

georgedaws
03-20-2011, 11:25 AM
Hi mamackillop,

I have just had a quick check back in and found your reply, now I am off to work!

Thank you for your reply, honestly mate I was beginning to give up hope.

Look, if you don't mind I am going to take it with me to work to have a play.

If I get any probs, can I let you know?

Thanks again.

mdmackillop
03-20-2011, 11:28 AM
Please post if there are any issues. Note that there was an error in Macro 2 (missing digit) where noted.

georgedaws
03-20-2011, 11:55 AM
Last check in for me tonight! (Out the door, kids hanging off my leg!!)

Error noted. Now that's premier service lol!

Stewart.

georgedaws
03-23-2011, 02:17 AM
Hi mdmackillop,

I've finally managed to test the code, and it works like a charm!

Honestly, I tried so many ways to do it myself. It's really has helped me. You are a star!!

Thank you.