0

I am trying to write a script that will take data from columns on two different sheets and paste them into a row on a third sheet without overwriting each other.

Private Sub CommandButton1_Click()
 Dim InRangex1 As Range
 Dim OutRangex1 As Range

 Dim i As Long

 Set InRangex1 = Sheets("Line 1").Range("L4:L204")
 Set OutRangex1 = Sheets("Numeric Plot").Range("B1")
 InRangex1.Worksheet.Activate
 InRangex1.Select
 Selection.Copy
 OutRangex1.Worksheet.Activate
 OutRangex1.Select
 Selection.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True, Transpose:=True

 Dim InRangex2 As Range
 Dim OutRangex2 As Range

 Set InRangex2 = Sheets("Line 3").Range("L4:L204")
 Set OutRangex2 = Sheets("Numeric Plot").Range("B1").End(xlToRight).Offset(0, 1).Select
 InRangex2.Worksheet.Activate
 InRangex2.Select
 Selection.Copy
 OutRangex2.Worksheet.Activate
 OutRangex2.Select
 Selection.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True, Transpose:=True

End Sub

I am getting a 424 "Object required" error when the second half of the script runs. Not sure where the problem is.

Rob Dome
  • 27
  • 4
  • Side note: see https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba and avoid `Select` and `Activate`. – BigBen Feb 19 '20 at 19:34
  • `InRangex2.Worksheet.Activate` is not correct. `InRangex2` it is declared like a `Range` and it does not have a `Worksheet` property. But, test my answer, please. The code is simpler and works very fast, avoiding selecting, activating, copy - paste... – FaneDuru Feb 19 '20 at 20:42

1 Answers1

1

Test this code, please. It it simpler, avoids Select, Activate, Copy and Paste and is very fast...

Private Sub CommandButton1_Click()
 Dim arr1 As Variant, arr2 As Variant, OutRangex2 As Range

 arr1 = Sheets("Line 1").Range("L4:L204").Value
 Sheets("Numeric Plot").Range("B1").Resize(1, UBound(arr1, 1)).Value = WorksheetFunction.Transpose(arr1)

 arr2 = Sheets("Line 3").Range("L4:L204").Value
 Set OutRangex2 = Sheets("Numeric Plot").Range("B1").End(xlToRight).Offset(0, 1)
  OutRangex2.Resize(1, UBound(arr2, 1)).Value = WorksheetFunction.Transpose(arr2)
End Sub

I think the duplicates removal should be consider like being object of a new question, according to our rules...

Please test the next code. It works also using arrays and should be very speedy. Please let me know how it works. It could be integrated in the first sub, but I made it from scratch...

Sub removeDuplicate()
 Dim arrSort As Variant, lastCol As Long, lastRow As Long, arrSorted As Variant, sh As Worksheet
  Set sh = Sheets("Numeric Plot")
  lastCol = sh.Cells(1, sh.Cells.Columns.count).End(xlToLeft).column 'last col on the first row
  arrSort = sh.Range(sh.Cells(1, 2), sh.Cells(1, lastCol)).Value        'put the row values in an array
  'transpose the array in a column after the last one of the rows 1:
  sh.Cells(1, lastCol + 1).Resize(UBound(arrSort, 2), 1).Value = WorksheetFunction.Transpose(arrSort)
  'remove duplicates with Excel function:
  sh.Range(sh.Cells(1, lastCol + 1), sh.Cells(UBound(arrSort, 2), lastCol + 1)).RemoveDuplicates Columns:=1, Header:=xlNo
  lastRow = sh.Cells(sh.Cells.Rows.count, lastCol + 1).End(xlUp).row 'Last row after dupplicate elimination
  arrSorted = sh.Range(sh.Cells(1, lastCol + 1), sh.Cells(lastRow, lastCol + 1)).Value 'The cleared column pun in an array
    sh.Range(sh.Cells(1, 2), sh.Cells(1, lastCol)).Clear                     'clearing the data of the first row
    sh.Range(sh.Cells(1, lastCol + 1), sh.Cells(lastRow, lastCol + 1)).Clear 'clearing the data of temporary column
    Dim finalRng As Range
     Set finalRng = sh.Range("B1").Resize(1, UBound(arrSorted))
    finalRng.Value = WorksheetFunction.Transpose(arrSorted) 'transpose the fiterred array

   'sort the resulted range:
   finalRng.Sort Key1:=finalRng, Order1:=xlAscending, Orientation:=xlLeftToRight
End Sub
FaneDuru
  • 38,298
  • 4
  • 19
  • 27
  • that works great, how would I sort and remove duplicates? – Rob Dome Feb 19 '20 at 20:53
  • Glad to help. I will shortly prepare a proc able to remove duplicates (it is a little tricky to make that on a row). Now it is late in my country and I will try something about sorting (maybe to amend the one which I will prepare now) tomorrow... – FaneDuru Feb 19 '20 at 21:46
  • WOW! thanks so much, I used `Sheets("Numeric Plot").Range("B1:ZZ1").Sort Key1:=Range("B1:ZZ1"), Order1:=xlAscending, Orientation:=xlLeftToRight` to sort at the end of the script. – Rob Dome Feb 19 '20 at 22:17
  • It should work, but you must adapt it for your real Range. I will update all second answer to target your necessary worksheet and also do the sorting for the specific range. But, besides that. I would like to emphasize that the purpose of this site is to teach as many people interested in learning, as possible. If somebody will look for a solution to remove duplicates and sort a row, he will never reach this post. Try posting my initial answer code and ask for a solution to replace duplicate and sorting of the range. Saying that you did not find a solution to eliminate duplicates in a row. – FaneDuru Feb 20 '20 at 08:02
  • @Rob Dome: If you will tag me (putting FaneDuru (with `at` in front of it) in your comment) here, in a next comment, I will post there my solution. And, who knows, maybe you will receive there a better one... Even i have in mind a better (shorter) solution. No necessary to vote there my code. You can do that for some other answer. But speaking of that, you have the necessary reputation to vote up this my answer and I am asking myself why you didn't... When you mark the code like accepted answer if you like it, usually people able to vote up does that... – FaneDuru Feb 20 '20 at 08:06
  • thanks for the help and advice. I'm still learning the ins and outs of the forum's rules and etiquette. – Rob Dome Feb 20 '20 at 12:16
  • @Rob Dome: Nobody has been born knowing everything... Here i could be notified, only because you are commenting on my answer, but if you would do that on your question, I would not be notified. That's why it is good to use the name tag... – FaneDuru Feb 20 '20 at 12:23