NEED TO CORRECT THIS CODE

[wndncg]

Basically it adds the data where it based on cell A1 & E1

What i want:

currently the code adds the data on the end of the cell, what i want to add on the current cell:

---

Sub DATA_DATE_LAST()

Dim wsData As Worksheet
Dim wsTemp As Worksheet
Dim v As Variant
Dim LR As Long
Dim r As Long

Application.ScreenUpdating = False

' Set worksheet variables
Set wsData = Sheets("TEMPLATE")
Set wsTemp = Sheets("FIN")

' Capture value to filter on
v = wsData.Range("A1")
dd = wsData.Range("E1")

' First clear range on TEMPLATE_SHEET
' wsTemp.Activate
' Rows("4:" & Rows.Count).Delete

' Find last row on DATA_SHEET
wsData.Activate
LR = Cells(Rows.Count, "B").End(xlUp).Row

' Loop through all rows on DATA_SHEET
For r = 1 To LR
' Check value in column A
If Cells(r, "B") = v And Cells(r, "A") = dd Then
' Copy columns B-D to TEMPLATE_SHEET
Range(Cells(r, "A"), Cells(r, "D")).Copy wsTemp.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

Range(Cells(r, "E"), Cells(r, "K")).Copy wsTemp.Cells(Rows.Count, "N").End(xlUp).Offset(1, 0)

Range(Cells(r, "L"), Cells(r, "M")).Copy wsTemp.Cells(Rows.Count, "X").End(xlUp).Offset(1, 0)
End If
Next r
'Call ADD_SEQ_01
Application.Wait (Now + TimeValue("00:00:01"))
'Call ADD_SEQ_02
Application.ScreenUpdating = True
wsTemp.Activate
MsgBox "ADDED_-WNDNCG"
End Sub

 

[wndncg]

If it doesn't impact on the other actions in the If statement you will need to have another If statement inside the previous one such as:

If .Cells(r, "B") = v And .Cells(r, "A") = dd Then
    ' Copy columns B-D to TEMPLATE_SHEET
    .Range(.Cells(r, "A"), .Cells(r, "D")).Copy wsTemp.Cells(rowOutTemp, "A")
    .Range(.Cells(r, "E"), .Cells(r, "K")).Copy wsTemp.Cells(rowOutTemp, "N")
    .Range(.Cells(r, "L"), .Cells(r, "M")).Copy wsTemp.Cells(rowOutTemp, "X")
   
    If UCase(.Cells(r, "N")) = "OLD" Then
        ' do old action
    ElseIf UCase(.Cells(r, "N")) = "NEW" Then
        ' do NEW action
    Else
        ' what do do if neither are true
        ' this could be to do nothing
    End If
   
    rowOutTemp = rowOutTemp + 1
End If

The action same with this one what is the final code?

.Range(.Cells(r, "A"), .Cells(r, "D")).Copy wsTemp.Cells(rowOutTemp, "A")
.Range(.Cells(r, "E"), .Cells(r, "K")).Copy wsTemp.Cells(rowOutTemp, "N")
.Range(.Cells(r, "L"), .Cells(r, "M")).Copy wsTemp.Cells(rowOutTemp, "X")

 

[Alex Blakenburg]

What is it going to do differently If N is OLD as opposed to when it it NEW ?
If the answer is nothing then what is the point in testing whether it says OLD or NEW

 

[wndncg]

What is it going to do differently If N is OLD as opposed to when it it NEW ?
If the answer is nothing then what is the point in testing whether it says OLD or NEW

Working atm using this with your code but when i run it, it will add another blank row

If .Cells(r, "B") = v And .Cells(r, "A") = dd Then
' Copy columns B-D to TEMPLATE_SHEET
'.Range(.Cells(r, "A"), .Cells(r, "D")).Copy wsTemp.Cells(rowOutTemp, "A")
'.Range(.Cells(r, "E"), .Cells(r, "K")).Copy wsTemp.Cells(rowOutTemp, "N")
'.Range(.Cells(r, "L"), .Cells(r, "M")).Copy wsTemp.Cells(rowOutTemp, "X")
If UCase(.Cells(r, "N")) = "NEW" Then
.Range(.Cells(r, "A"), .Cells(r, "D")).Copy wsTemp.Cells(rowOutTemp, "A")
.Range(.Cells(r, "E"), .Cells(r, "K")).Copy wsTemp.Cells(rowOutTemp, "N")
.Range(.Cells(r, "L"), .Cells(r, "M")).Copy wsTemp.Cells(rowOutTemp, "X")
ElseIf UCase(.Cells(r, "N")) = " " Then

Else

End If
rowOutTemp = rowOutTemp + 1
End If

 

[Alex Blakenburg]

That's because it was not clear from your description on how you wanted to use the NEW and OLD criteria.

Based on what is working for you the code would have been this:

If .Cells(r, "B") = v And .Cells(r, "A") = dd And UCase(.Cells(r, "N")) = "NEW" Then
    .Range(.Cells(r, "A"), .Cells(r, "D")).Copy wsTemp.Cells(rowOutTemp, "A")
    .Range(.Cells(r, "E"), .Cells(r, "K")).Copy wsTemp.Cells(rowOutTemp, "N")
    .Range(.Cells(r, "L"), .Cells(r, "M")).Copy wsTemp.Cells(rowOutTemp, "X")
End If
rowOutTemp = rowOutTemp + 1

 

[wndncg]

That's because it was not clear from your description on how you wanted to use the NEW and OLD criteria.

Based on what is working for you the code would have been this:

If .Cells(r, "B") = v And .Cells(r, "A") = dd And UCase(.Cells(r, "N")) = "NEW" Then
    .Range(.Cells(r, "A"), .Cells(r, "D")).Copy wsTemp.Cells(rowOutTemp, "A")
    .Range(.Cells(r, "E"), .Cells(r, "K")).Copy wsTemp.Cells(rowOutTemp, "N")
    .Range(.Cells(r, "L"), .Cells(r, "M")).Copy wsTemp.Cells(rowOutTemp, "X")
End If
rowOutTemp = rowOutTemp + 1

how to add? like this?

If .Cells(r, "B") = v And .Cells(r, "A") = dd And UCase(.Cells(r, "N")) = "NEW" Then
.Range(.Cells(r, "A"), .Cells(r, "D")).Copy wsTemp.Cells(rowOutTemp, "A")
.Range(.Cells(r, "E"), .Cells(r, "K")).Copy wsTemp.Cells(rowOutTemp, "N")
.Range(.Cells(r, "L"), .Cells(r, "M")).Copy wsTemp.Cells(rowOutTemp, "X")
End If
rowOutTemp = rowOutTemp + 1


'Else

'End If
'rowOutTemp = rowOutTemp + 1
'End If
End With
Next r

 

[Alex Blakenburg]

Difficult to tell since you don't use the VBA Code button but I think it looks OK.

 

[wndncg]

Difficult to tell since you don't use the VBA Code button but I think it looks OK.

can you fix? it adds 2 more cells

Sub DATA_DATE_MANUAL_SWITCH()
Dim wsData As Worksheet
Dim wsTemp As Worksheet
Dim v As Variant
Dim LR As Long
Dim r As Long
Dim dd As Date
Dim rowOutTemp As Long

Application.ScreenUpdating = False
' Set worksheet variables
Set wsData = Sheets("TEMPLATE")
Set wsTemp = Sheets("FIN")
v = wsData.Range("A1")
dd = wsData.Range("C1")
wsTemp.Activate
rowOutTemp = ActiveCell.Row ' XXX request was to output to Current Cell
' Capture value to filter on
Application.Wait (Now + TimeValue("00:00:01"))
Rows(ActiveCell.Row).Select
' First clear range on TEMPLATE_SHEET
' wsTemp.Activate
' Rows("4:" & Rows.Count).Delete
' Find last row on DATA_SHEET
' wsData.Activate ' XXX remove activation of sheet
LR = wsData.Cells(Rows.Count, "B").End(xlUp).Row

' Loop through all rows on DATA_SHEET
For r = 1 To LR
With wsData
' Check value in column A


If .Cells(r, "B") = v And .Cells(r, "A") = dd And UCase(.Cells(r, "N")) = "NEW" Then
.Range(.Cells(r, "A"), .Cells(r, "D")).Copy wsTemp.Cells(rowOutTemp, "A")
.Range(.Cells(r, "E"), .Cells(r, "K")).Copy wsTemp.Cells(rowOutTemp, "N")
.Range(.Cells(r, "L"), .Cells(r, "M")).Copy wsTemp.Cells(rowOutTemp, "X")
End If
rowOutTemp = rowOutTemp + 1


'Else

'End If
'rowOutTemp = rowOutTemp + 1
'End If
End With
Next r

Application.ScreenUpdating = True
MsgBox "ADDED_-WNDNCG"
End Sub

 

[Alex Blakenburg]

Repost the code using the VBA button and I will take a look.
Also give me a screen shot of what it is doing and what you are expecting it to do.

 

[wndncg]

code works added in ws_data thing.

 

[Alex Blakenburg]

Thanks for letting me know. Glad we got it sorted.