Macro to paste Approval Data from Row 2 and Reject Data from Row 20 on sheet2

[Silver]

Hi,

I have 2 workbooks - Approval and Reject.

Both have 2 buttons each - Transfer and Userform.

When clicked on Transfer button, macro copies data from sheet1 and pastes them to specific columns on sheet2. The data is pasted from row 2 onwards.

When clicked on Userform button, macro enters data into specific columns on sheet2. The data is entered from row 2 onwards.

Below is the Transfer code used in Approval workbook


Sub Approve() Dim arr, c As Range, r As Range, FA As String
Set DestnSheet = Sheets("Sheet2") 'just so that this line is the only line to change if you want to change the destination sheet.
FirstNameRow = 15 'most keywords' first names start in row 8.


'Find Ticket numbers
With Sheets("Sheet1").Columns("B")
Set c = .Find("Ticket number", after:=Cells(1, 2))
Set r = c
FA = c.Address
Do
Set c = .FindNext(c)
If c.Address = FA Then Exit Do
Set r = Union(r, c)
Loop
End With


For Each cel In r
With Sheets("Sheet1") 'ActiveSheet ''Activesheet, specific sheet, whichever.
Select Case .Range("C8") 'the keyword.
Case "ABC"
ToColms = Array("D", "N", "O", "G", "I", "E") 'these are destination columns
FromRows = Array(2, 5, 8, 11, 12, 15)
Case "def", "ghi", "zzz" 'this includes any other keywords that share the same destination column pattern.
ToColms = Array("C", "L", "J") 'these are destination columns
FromRows = Array(3, 5, 6)
Case "DEF"
ToColms = Array("D", "N", "O", "G", "I", "Q", "R") 'these are destination columns
FromRows = Array(2, 5, 8, 11, 12, 13, 14)
FirstNameRow = 18
'Case Else
'ToColms = Array("P", "Q", "R", "S", "T") 'default destination columns for any other keyword not in above Cases.
'FromRows = Array(99, 98, 97, 96, 95)
End Select
i = LBound(ToColms) 'the rows on sheet1 (column C) where data is always pasted.
With DestnSheet
DestnRow = .Range("D:X").Find("*", .Range("D1"), , , xlByRows, xlPrevious).Row + 1
End With
For Each rw In FromRows
DestnSheet.Cells(DestnRow, ToColms(i)).Value = .Cells(rw, "C").Value
i = i + 1
Next rw
DestnSheet.Cells(DestnRow, "E").Value = cel.Offset(, 1).Value
DestnSheet.Cells(DestnRow, "J").Value = cel.Offset(1, 1).Value 'cell below the name
DestnSheet.Cells(DestnRow, "X").Value = cel.Offset(2, 1).Value 'cell below the name
End With
Next cel
End Sub

Below is the Userform code used in Approval workbook


Const F = "dd-mm-yy hh:mm"

Private Sub CommandButton1_Click()
N% = Val(TextBox11.Text)
If N < 1 Then TextBox10.SetFocus: Beep: Exit Sub
V = [{8,11,12,13,16,19,20,21,22,23}]
r& = Sheet2.Cells(Sheet2.Rows.Count, V(1)).End(xlUp)(2).Row
For c% = 1 To UBound(V)
Sheet2.Cells(r, V(c)).Resize(N).Value = Me.Controls("TextBox" & c).Text
Me.Controls("TextBox" & c).Text = ""
Next
UserForm_Initialize
End Sub


Private Sub TextBox2_Enter()
TextBox2.Text = Format$(Now, F)
End Sub


Private Sub UserForm_Initialize()
TextBox3.Text = Format$(Now, F)
TextBox11.Text = "1"
End Sub
Private Sub TextBox4_Enter()
TextBox4.Text = Format$(Now, F)
End Sub


The same code is used in Reject workbook.

I will be maintaining a single workbook where both Approval and Reject data will be saved.

Below is how Transfer and Userform buttons will look in the new workbook.

16529

Based on above pic below is what I want the macro to do.

Under Approval when -
a) Clicked on Transfer, macro should paste data from row 2 onwards on sheet2
b) Clicked on Userform, macro should paste data from row 2 onwards on sheet2

Under Reject when -
a) Clicked on Transfer, macro should paste data from row 20 onwards on sheet2
b) Clicked on Userform, macro should paste data from row 20 onwards on sheet2

In the attached sheet I have included Transfer and Userform code to all 4 buttons.

Note -

Below is how the buttons and codes are linked

Under Approval
a) Transfer Button- Sub Approve() (Code is in sheet1)
b) Userform Button - Sub App () (Code is in Userform1)

Under Reject
a) Transfer Button- Sub Reject() (Code is in sheet2)
b) Userform Button - Sub Rej () (Code is in Userform2)

Any assistance will be appreciated.

[mamanton10]

Can you specifically mention the issue that you face. Also it is better if you just get solved one "Approval" section and then apply the same method to the other. Let me know the problem that you face now.

[Silver]

mamanton10...Thanks for responding.

The basic idea is -
a) when the approval macro is run (Transfer and Userform) the data should be pasted from row 2
b) when the reject macro is run (Transfer and Userform) the data should be pasted from row20

In the attached workbook on sheet2 I have used numbers as Headers for both Approval and Reject.

Header for Approval is on row 2 and header for Reject is on row 19.

Problem Faced

If I remove header from row 19 and run both Approval and Reject macros (Transfer and Userform). The data for both is pasted from row 2 onwards.

If I add header from row 19 and run both macros, the data for both is pasted from row 20 onwards.

Above explanation can be tested out on the attached sheet.

What I'm looking for

There must be some code which will tell macro to paste approval data from row 2 and reject data from row 20.

Kindly help me out.

[mamanton10]

Hi Sorry for the late reply. I got stuck with some work. Pls. try to change the below code Range as you are specifically starting to enter the reject data from Column 19.

DestnRow = .Range("D1:X18").Find("*", .Range("D1"), , , xlByRows, xlPrevious).Row + 1

Change the range from - D:X to D1:X18. Hope you can now continue with your project.

Visit my blog - macroprog . blogspot . com

[Silver]

Hi,

I changed the code as you suggested but it does not paste data from row 19.

Can you check and confirm.

[mamanton10]

Hi, That change is for your "Approval" transfer only. Just change the other ranges as appropriate. I changed the above code it worked fine.

With DestnSheet
DestnRow = .Range("D1:X18").Find("*", .Range("D1"), , , xlByRows, xlPrevious).Row + 1
End With

Change others as required. Because when you give that rage without a limit parameter then the excel file always pick the last word and the next row of that. SO specify the range so that you are fine...

[Silver]

Hi,

Changed the code so the data gets pasted from Range D20:X30.

Getting an error as Run-time error : Type mismatch

Below is the code that I used


With DestnSheet
DestnRow = .Range("D20:X30").Find("*", .Range("D1"), , , xlByRows, xlPrevious).Row + 1
End With

[mdmackillop]

You cannot start a search of a range from a cell which is not in the range.

[Silver]

Just used a different piece of code... and it works


With DestnSheet
Dim rr as Range, rcell as Range, rrr as range
set rr = .Range("D2:D10")
for each rcell in rr
if len(trim(rcell.Text)) = 0 then
set rrr = rcell
exit for
end if
Next
End With
DestnRow = rrr.row

[mdmackillop]

It may work, but not the way to do it. Just change D1 to D20; Read about Find in VBA Help.