VBA WorkSheet_Change dont work with Template Wizard inputs

41 views Asked by At

What i have in my files

A Excel Template

A Database to store the template

Both of the files are created by Template Wizard

Purpose of me using the TW is because i have to design a interactive form to send to other users for them to fill up and send it back to me and once i go into the template and save it, it will auto store it into the database that i had create in a folder at my desktop so far the template and database transferring is working out GREAT. But i decided to do more.

Main Objective

So what i wanted to do is everytime the database updates by itself, i wanted to use the worksheet_Change function to let it auto sort by itself. So let's say if it says "Yes" at column C, i would want it to grab the whole row in the database tab and shift it to the "D" tab And as for "No" it will shift it to "U" Tab So i tried it on a dummy excel file and with copy and pasting it works. BUT so i tried on the original database and the thing about template wizard is that it is not copy pasting so i dont think it works as the same like i did for manual copy and pasting.

CODE

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Columns("C:C")) Is Nothing Then Exit Sub
    Dim cel As Range
    For Each cel In Intersect(Target, Columns("C:C")).Cells
        If cel.Value = "Yes" Then
            With Sheets("U")
                With .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).EntireRow
                    .Range("A1:I1").Value = Rows(cel.Row).Range("A1:I1").Value
                    .Range("J1:AB1").Value = Rows(cel.Row).Range("AC1:AU1").Value
                    .Range("AC1:AE1").Value = Rows(cel.Row).Range("AV1:AX1").Value
                End With
            End With

        ElseIf cel.Value = "No" Then
            With Sheets("D")
                With .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).EntireRow
                    .Range("A1:AB1").Value = Rows(cel.Row).Range("A1:AB1").Value
                    .Range("AC1:AE1").Value = Rows(cel.Row).Range("AV1:AX1").Value
                End With
            End With
        End If
    Next
End Sub

Error

The error for the macro points at both With Sheets("U") With Sheets("D")

So if my form were to populate "Yes" The With Sheets("U") will be highlighted with error

and if i were to populate with "No" The With Sheets("D") will be highlighted with error

Might need to change Worksheet_Change to other function.. but how to make it more smart and efficient? Thanks for reading

1

There are 1 answers

0
Romcel Geluz On
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Columns("C:C")) Is Nothing Then Exit Sub
    Dim cel As Range
    Dim rngReceiver As Range
    Dim rngDonor As Range
    For Each cel In Intersect(Target, Columns("C:C")).Cells
      If cel.Value = "Yes" Then
        Set rngReceiver = Sheets("U").Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
        rngReceiver.Resize(0, 8).Value = cel.Resize(0, 8).Value '<~ copying A:I, pasting to A1:I1
        rngReceiver.Offset(0, 9).Resize(0, 18).Value = cel.Offset(0, 28).Resize(0, 18).Value '<~copying AC1:AU1 pasting to J1:AB1
        rngReceiver.Offset(0, 28).Resize(0, 2).Value = cel.Offset(0, 47).Resize(0, 2).Value '<~copying AV1:AX1 pasting to AC1:AE1
      ElseIf cel.Value = "No" Then
        Set rngReceiver = Sheets("D").Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).EntireRow
        rngReceiver.Resize(0, 27).Value = cel.Resize(0, 27).Value '<~ copying A1:AB1 pasting to A1:AB1
        rngReceiver.Offset(0, 28).Resize(0, 2).Value = cel.Offset(0, 47).Resize(0, 2).Value '<~ copying AV1:AX1 pasting to AC1:AE1
      End If
    Next
End Sub

posting this answer without testing.