+ Reply to Thread
Results 1 to 9 of 9

Looking to add code to existing code.

Hybrid View

  1. 08-11-2016, 09:09 AM #1
    Nitro2481
    Nitro2481 is offline
    Forum Contributor Nitro2481's Avatar
    Join Date
    09-09-2014
    Location
    Laois, Ireland
    MS-Off Ver
    2013
    Posts
    323

    Looking to add code to existing code.

    Hi guys,

    I currently have this code in my sheet
    Dim rw As Long, CopyTo  As String
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
   If Not Intersect(Target, Range("AB:AC")) Is Nothing Then
      With Target
         If UCase(.Value) = "BLOCK" Then
            If .Column = 28 Then
               CopyTo = "Banc ***"
               rw = Sheets(CopyTo).Range("E" & Rows.Count).End(xlUp).Row + 1
               Range("B" & .Row).Copy
                      Sheets(CopyTo).Range("E" & rw).PasteSpecial (xlPasteValues)
               Range("AB" & .Row).Copy
                      Sheets(CopyTo).Range("f" & rw).PasteSpecial (xlPasteValues)
               Sheets(CopyTo).Range("J" & rw).Value = "Sent Up"   'Put "Sent Up" in Column J
            ElseIf .Column = 29 Then
               CopyTo = "Home Ins"
               rw = Sheets(CopyTo).Range("D" & Rows.Count).End(xlUp).Row + 1
               Range("B" & .Row & ":C" & .Row).Copy
                     Sheets(CopyTo).Range("D" & rw).PasteSpecial (xlPasteValues)
               Range("AC" & .Row).Copy
                      Sheets(CopyTo).Range("F" & rw).PasteSpecial (xlPasteValues)
               Range("D" & .Row).Copy
                      Sheets(CopyTo).Range("g" & rw).PasteSpecial (xlPasteValues)
               Sheets(CopyTo).Range("J" & rw).Value = "Sent Up"   'Put "Sent Up" in Column K

            End If
         End If
      End With
   End If
   Const sPW            As String = "$AJ$1"
   Const sHide          As String = "Aa:Aa, Ak:Ak, Ap:Ap, AQ:AQ, Av:Av, Aw:Aw, Bb:Bb, Bc:Bc, Bh:Bh, Bi:Bi, Bn:Bn, Bo:Bo, Bt:Bt, Bu:Bu, Bz:Bz, Ca:Ca "
   If Not Intersect(Target, Range(sPW)) Is Nothing Then
      If Target.Value = 1234 Then
         
         'Range(sHide & 1).EntireColumn.Hidden = False
         Range(sHide).EntireColumn.Hidden = False
      
      ElseIf Target.Value = "" Then
    
         
         'Range(sHide & 1).EntireColumn.Hidden = True
         Range(sHide).EntireColumn.Hidden = True
      End If
   End If

    If Target.Column = 24 Then
      
      If Range("AB" & Target.Row) = "Block" Then
         lr = shtBASS.Range("B" & Rows.Count).End(xlUp).Row
         test = Sheets("Mort Figs").Range("B" & Target.Row).Value & Sheets("Mort Figs").Range("AB" & Target.Row).Value
         For x = 5 To lr
            test2 = shtBASS.Range("E" & x).Value & shtBASS.Range("F" & x).Value
            If test2 = test And Target.Value = "" And shtBASS.Range("J" & x) = "Issued" Then
                shtBASS.Range("J" & x) = "Sent Up"
                shtBASS.Range("K" & x) = ""
                Exit For
            ElseIf test2 = test And shtBASS.Range("J" & x) = "Sent Up" Then
                shtBASS.Range("J" & x) = "Issued"
                shtBASS.Range("K" & x) = Target.Value
               Exit For
            End If
         Next
End If

       
      If Range("AC" & Target.Row) = "Block" Then
         lr = shtHIN.Range("B" & Rows.Count).End(xlUp).Row
         test = Sheets("Mort Figs").Range("B" & Target.Row).Value & Sheets("Mort Figs").Range("AC" & Target.Row).Value
         For x = 5 To lr
            test2 = shtHIN.Range("D" & x).Value & shtHIN.Range("F" & x).Value
            If test2 = test And Target.Value = "" And shtHIN.Range("J" & x) = "Issued" Then
                shtHIN.Range("J" & x) = "Sent Up"
                shtHIN.Range("K" & x) = ""
                Exit For
            ElseIf test2 = test And shtHIN.Range("J" & x) = "Sent Up" Then
                shtHIN.Range("j" & x) = "Issued"
                shtHIN.Range("k" & x) = Target.Value
               Exit For
            End If
         Next
      End If

   End If
End Sub
    I'm trying to add this code
     If Target.Column = 6 Then
     thisrow = Target.Row
     Range("A" & thisrow) = Date
     End If
    Which I understand means "if anything is put in the 6th column "F" then put the date in the same row column "A". It is not working and I'm not sure why. I think I need to put "Dim thisrow As Long" at the top as well but that hasn't worked. Any help greatly appreciated.

    This is what I have tried with the changes in red but not working. 

    Dim rw As Long, CopyTo  As String
Dim thisrow As Long


Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
   If Not Intersect(Target, Range("AB:AC")) Is Nothing Then
      With Target
         If UCase(.Value) = "BLOCK" Then
            If .Column = 28 Then
               CopyTo = "Banc ***"
               rw = Sheets(CopyTo).Range("E" & Rows.Count).End(xlUp).Row + 1
               Range("B" & .Row).Copy
                      Sheets(CopyTo).Range("E" & rw).PasteSpecial (xlPasteValues)
               Range("AB" & .Row).Copy
                      Sheets(CopyTo).Range("f" & rw).PasteSpecial (xlPasteValues)
               Sheets(CopyTo).Range("J" & rw).Value = "Sent Up"   'Put "Sent Up" in Column J
            ElseIf .Column = 29 Then
               CopyTo = "Home Ins"
               rw = Sheets(CopyTo).Range("D" & Rows.Count).End(xlUp).Row + 1
               Range("B" & .Row & ":C" & .Row).Copy
                     Sheets(CopyTo).Range("D" & rw).PasteSpecial (xlPasteValues)
               Range("AC" & .Row).Copy
                      Sheets(CopyTo).Range("F" & rw).PasteSpecial (xlPasteValues)
               Range("D" & .Row).Copy
                      Sheets(CopyTo).Range("g" & rw).PasteSpecial (xlPasteValues)
               Sheets(CopyTo).Range("J" & rw).Value = "Sent Up"   'Put "Sent Up" in Column K

            End If
         End If
      End With
   End If
   Const sPW            As String = "$AJ$1"
   Const sHide          As String = "Aa:Aa, Ak:Ak, Ap:Ap, AQ:AQ, Av:Av, Aw:Aw, Bb:Bb, Bc:Bc, Bh:Bh, Bi:Bi, Bn:Bn, Bo:Bo, Bt:Bt, Bu:Bu, Bz:Bz, Ca:Ca "
   If Not Intersect(Target, Range(sPW)) Is Nothing Then
      If Target.Value = 1234 Then
         
         'Range(sHide & 1).EntireColumn.Hidden = False
         Range(sHide).EntireColumn.Hidden = False
      
      ElseIf Target.Value = "" Then
    
         
         'Range(sHide & 1).EntireColumn.Hidden = True
         Range(sHide).EntireColumn.Hidden = True
      End If
   End If

    If Target.Column = 24 Then
      
      If Range("AB" & Target.Row) = "Block" Then
         lr = shtBASS.Range("B" & Rows.Count).End(xlUp).Row
         test = Sheets("Mort Figs").Range("B" & Target.Row).Value & Sheets("Mort Figs").Range("AB" & Target.Row).Value
         For x = 5 To lr
            test2 = shtBASS.Range("E" & x).Value & shtBASS.Range("F" & x).Value
            If test2 = test And Target.Value = "" And shtBASS.Range("J" & x) = "Issued" Then
                shtBASS.Range("J" & x) = "Sent Up"
                shtBASS.Range("K" & x) = ""
                Exit For
            ElseIf test2 = test And shtBASS.Range("J" & x) = "Sent Up" Then
                shtBASS.Range("J" & x) = "Issued"
                shtBASS.Range("K" & x) = Target.Value
               Exit For
            End If
         Next
End If

     If Target.Column = 6 Then
     thisrow = Target.Row
     Range("A" & thisrow) = Date
     End If
   
      If Range("AC" & Target.Row) = "Block" Then
         lr = shtHIN.Range("B" & Rows.Count).End(xlUp).Row
         test = Sheets("Mort Figs").Range("B" & Target.Row).Value & Sheets("Mort Figs").Range("AC" & Target.Row).Value
         For x = 5 To lr
            test2 = shtHIN.Range("D" & x).Value & shtHIN.Range("F" & x).Value
            If test2 = test And Target.Value = "" And shtHIN.Range("J" & x) = "Issued" Then
                shtHIN.Range("J" & x) = "Sent Up"
                shtHIN.Range("K" & x) = ""
                Exit For
            ElseIf test2 = test And shtHIN.Range("J" & x) = "Sent Up" Then
                shtHIN.Range("j" & x) = "Issued"
                shtHIN.Range("k" & x) = Target.Value
               Exit For
            End If
         Next
      End If

   End If
End Sub
    Reply With QuoteRegister To Reply
  2. 08-11-2016, 11:54 AM #2
    walruseggman
    walruseggman is offline
    Forum Expert
    Join Date
    08-28-2014
    Location
    Texas, USA
    MS-Off Ver
    2016
    Posts
    1,796

    Re: Looking to add code to existing code.

    I believe you have that nested inside your If Target.Column = 24 statement. So it'll only get evaluated if the column is 24, and then it will evaluate false because 24 <> 6.

    Move your red code to just before the End Sub. It should work fine then.

    I would also add

    If Target.Column = 6
Application.EnableEvents = False
'...your code
Application.EnableEvents = True
End If
    to the code, because adding that date to column A is going to retrigger the Worksheet_Change event again, and I don't think you want that. That line of code will prevent that from happening.
    Last edited by walruseggman; 08-11-2016 at 11:57 AM.
    I'm interested in starting a career working with VBA, if anyone knows of any opportunities!
    Reply With QuoteRegister To Reply
  3. 08-11-2016, 12:11 PM #3
    Nitro2481
    Nitro2481 is offline
    Forum Contributor Nitro2481's Avatar
    Join Date
    09-09-2014
    Location
    Laois, Ireland
    MS-Off Ver
    2013
    Posts
    323

    Re: Looking to add code to existing code.

    Hey @walruseggman (cool name btw)

    These are the changes to my original code. I always get nervous with the enable events thing. It is now doing what I want it to, I just want to make sure I'm not damaging anything else. Does this new code look right to you?

    Dim rw As Long, CopyTo  As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim thisrow As Long


  If Target.Count > 1 Then Exit Sub
   If Not Intersect(Target, Range("AB:AC")) Is Nothing Then
      With Target
         If UCase(.Value) = "BLOCK" Then
            If .Column = 28 Then
               CopyTo = "Banc ***"
               rw = Sheets(CopyTo).Range("E" & Rows.Count).End(xlUp).Row + 1
               Range("B" & .Row).Copy
                      Sheets(CopyTo).Range("E" & rw).PasteSpecial (xlPasteValues)
               Range("AB" & .Row).Copy
                      Sheets(CopyTo).Range("f" & rw).PasteSpecial (xlPasteValues)
               Sheets(CopyTo).Range("J" & rw).Value = "Sent Up"   'Put "Sent Up" in Column J
            ElseIf .Column = 29 Then
               CopyTo = "Home Ins"
               rw = Sheets(CopyTo).Range("D" & Rows.Count).End(xlUp).Row + 1
               Range("B" & .Row & ":C" & .Row).Copy
                     Sheets(CopyTo).Range("D" & rw).PasteSpecial (xlPasteValues)
               Range("AC" & .Row).Copy
                      Sheets(CopyTo).Range("F" & rw).PasteSpecial (xlPasteValues)
               Range("D" & .Row).Copy
                      Sheets(CopyTo).Range("g" & rw).PasteSpecial (xlPasteValues)
               Sheets(CopyTo).Range("J" & rw).Value = "Sent Up"   'Put "Sent Up" in Column K

            End If
         End If
      End With
   End If
   Const sPW            As String = "$AJ$1"
   Const sHide          As String = "Aa:Aa, Ak:Ak, Ap:Ap, AQ:AQ, Av:Av, Aw:Aw, Bb:Bb, Bc:Bc, Bh:Bh, Bi:Bi, Bn:Bn, Bo:Bo, Bt:Bt, Bu:Bu, Bz:Bz, Ca:Ca "
   If Not Intersect(Target, Range(sPW)) Is Nothing Then
      If Target.Value = 1234 Then
         
         'Range(sHide & 1).EntireColumn.Hidden = False
         Range(sHide).EntireColumn.Hidden = False
      
      ElseIf Target.Value = "" Then
    
         
         'Range(sHide & 1).EntireColumn.Hidden = True
         Range(sHide).EntireColumn.Hidden = True
      End If
   End If

    If Target.Column = 24 Then
      
      If Range("AB" & Target.Row) = "Block" Then
         lr = shtBASS.Range("B" & Rows.Count).End(xlUp).Row
         test = Sheets("Mort Figs").Range("B" & Target.Row).Value & Sheets("Mort Figs").Range("AB" & Target.Row).Value
         For x = 5 To lr
            test2 = shtBASS.Range("E" & x).Value & shtBASS.Range("F" & x).Value
            If test2 = test And Target.Value = "" And shtBASS.Range("J" & x) = "Issued" Then
                shtBASS.Range("J" & x) = "Sent Up"
                shtBASS.Range("K" & x) = ""
                Exit For
            ElseIf test2 = test And shtBASS.Range("J" & x) = "Sent Up" Then
                shtBASS.Range("J" & x) = "Issued"
                shtBASS.Range("K" & x) = Target.Value
               Exit For
            End If
         Next
End If

      
      If Range("AC" & Target.Row) = "Block" Then
         lr = shtHIN.Range("B" & Rows.Count).End(xlUp).Row
         test = Sheets("Mort Figs").Range("B" & Target.Row).Value & Sheets("Mort Figs").Range("AC" & Target.Row).Value
         For x = 5 To lr
            test2 = shtHIN.Range("D" & x).Value & shtHIN.Range("F" & x).Value
            If test2 = test And Target.Value = "" And shtHIN.Range("J" & x) = "Issued" Then
                shtHIN.Range("J" & x) = "Sent Up"
                shtHIN.Range("K" & x) = ""
                Exit For
            ElseIf test2 = test And shtHIN.Range("J" & x) = "Sent Up" Then
                shtHIN.Range("j" & x) = "Issued"
                shtHIN.Range("k" & x) = Target.Value
               Exit For
            End If
         Next
      End If

   End If
   If Target.Column = 6 Then
   thisrow = Target.Row
   Range("A" & thisrow) = Date
   Application.EnableEvents = False
   
   Application.EnableEvents = True
   End If   
   
   
End Sub
    Reply With QuoteRegister To Reply
  4. 08-11-2016, 12:51 PM #4
    walruseggman
    walruseggman is offline
    Forum Expert
    Join Date
    08-28-2014
    Location
    Texas, USA
    MS-Off Ver
    2016
    Posts
    1,796

    Re: Looking to add code to existing code.

    No. You want EnableEvents = False BEFORE your code makes any changes to the sheet. 

      If Target.Column = 6 Then
   Application.EnableEvents = False
   thisrow = Target.Row
   Range("A" & thisrow) = Date
   
   Application.EnableEvents = True
   End If
    Reply With QuoteRegister To Reply
  5. 08-11-2016, 01:00 PM #5
    Nitro2481
    Nitro2481 is offline
    Forum Contributor Nitro2481's Avatar
    Join Date
    09-09-2014
    Location
    Laois, Ireland
    MS-Off Ver
    2013
    Posts
    323

    Re: Looking to add code to existing code.

    Perfect. However this is now giving me a problem I didn't foresee. I type in column f date goes in column A. Perfect. I then later on need to delete column f but that updates column a again. How do I delete f and keep a as it was?
    Reply With QuoteRegister To Reply
  6. 08-11-2016, 01:06 PM #6
    walruseggman
    walruseggman is offline
    Forum Expert
    Join Date
    08-28-2014
    Location
    Texas, USA
    MS-Off Ver
    2016
    Posts
    1,796

    Re: Looking to add code to existing code. 

    If Target.Column = 6 Then
   Application.EnableEvents = False
   thisrow = Target.Row
   If Range("A" & thisrow) = "" Then Range("A" & thisrow) = Date
   
   Application.EnableEvents = True
   End If
    Reply With QuoteRegister To Reply
  7. 08-11-2016, 04:32 PM #7
    Nitro2481
    Nitro2481 is offline
    Forum Contributor Nitro2481's Avatar
    Join Date
    09-09-2014
    Location
    Laois, Ireland
    MS-Off Ver
    2013
    Posts
    323

    Re: Looking to add code to existing code.

    Thanks a mil. I'll try that tomorrow.
    Reply With QuoteRegister To Reply
  8. 08-12-2016, 04:17 AM #8
    Nitro2481
    Nitro2481 is offline
    Forum Contributor Nitro2481's Avatar
    Join Date
    09-09-2014
    Location
    Laois, Ireland
    MS-Off Ver
    2013
    Posts
    323

    Re: Looking to add code to existing code.

    Hey thanks a million. That worked perfect. Appreciate the help.

    Matt
    Reply With QuoteRegister To Reply
  9. 08-12-2016, 04:20 AM #9
    Nitro2481
    Nitro2481 is offline
    Forum Contributor Nitro2481's Avatar
    Join Date
    09-09-2014
    Location
    Laois, Ireland
    MS-Off Ver
    2013
    Posts
    323

    Re: Looking to add code to existing code.

    That worked perfect. Thanks a million for the support

    Matt
    Reply With QuoteRegister To Reply
+ Reply to Thread
« Previous Thread | Next Thread »

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Inserting Progress Bar Code Into Existing VBA Code
    By BDBJ1 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 03-15-2016, 11:58 AM
  2. [help with code] need to update existing code to copy and keep rows on input page
    By scott micklo in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 01-25-2016, 01:36 PM
  3. [SOLVED] VBA code in existing code to open when workbook encrypt with password.
    By deo_y in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 08-26-2014, 07:08 AM
  4. [SOLVED] VBA code to save current worksheet as temporary PDF file and then add to my existing code
    By brianfromla in forum Excel Programming / VBA / Macros
    Replies: 6
    Last Post: 05-20-2014, 08:35 AM
  5. How to incorporate deleting duplicate code into existing copy to new sheet code when new v
    By Rizla21 in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 12-17-2013, 11:51 AM
  6. Adding cell zoom code to already existing code in single worksheet
    By billyster in forum Excel General
    Replies: 2
    Last Post: 03-17-2011, 08:55 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Forum Rules


Search Engine Friendly URLs by vBSEO 3.6.0 RC 1