Copy rows to other sheets based on value in column

Solved/Closed
MsBluebird Posts 7 Registration date Thursday July 25, 2019 Status Member Last seen July 26, 2019 - Updated on Jul 25, 2019 at 12:42 PM
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 - Jul 26, 2019 at 06:48 PM
Hello,

System Configuration: Windows / Chrome 75.0.3770.142

I have copy and pasted the code used to solve the problem for the question which began this thread.
I have 6 tabs into which I want to copy data based on inputs in column E.
I have named my tabs, but I can't see that this should be a problem.
code is below and data
Sub TransferData()

Dim ar As Variant
Dim i As Integer
Dim lr As Long

ar = Array("1 ADJUVANT", "2 2,4-D MANY CAS #", "16 ALDICARB", "60 CHLOROTHALONIL", "97 ENDOTHALL", "146 GLYPHOSATE")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 0 To UBound(ar)

'problem is in this row. To be fair, I don't know what the 7,, 0 means

testingData.Range("e2", testingData.Range("e" & testingData.Rows.Count).End(xlUp)).AutoFilter 1, ar(i), 7, , 0
lr = testingData.Range("e" & Rows.Count).End(xlUp).Row
If lr > 1 Then
testingData.Range("e2", testingData.Range("e" & testingData.Rows.Count).End(xlUp)).EntireRow.Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
Sheets(ar(i)).Columns.AutoFit
End If
Next i
testindData.[e2].AutoFilter

Is there a way for me to show you a portion of my data?

4 responses

Blocked Profile
Jul 25, 2019 at 09:54 AM
You range is not constucted properly.

A range is defined as in Range ("A1:J10")

If you were to replace the variable that are making the range, you would notice that the range is missing thedelimitor of ":".

So, replace the first comma with this

&":"&

To make it

Testingdata.Range ("e2" & ":" & .........


give that a try.

0
MsBluebird Posts 7 Registration date Thursday July 25, 2019 Status Member Last seen July 26, 2019
Jul 25, 2019 at 10:22 AM
Thanks so much for your suggestions. I still get a 424 object not defined message.

Sub TransferData()

Dim ar As Variant
Dim i As Integer
Dim lr As Long

ar = Array("1 ADJUVANT", "2 2,4-D MANY CAS #", "16 ALDICARB", "60 CHLOROTHALONIL", "97 ENDOTHALL", "146 GLYPHOSATE")

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 0 To UBound(ar)
testingData.Range("e2" & ":" & testingData.Range("e" & testingData.Rows.Count).End(xlUp)).AutoFilter 1, ar(i), 7, , 0
lr = testingData.Range("e" & Rows.Count).End(xlUp).Row
If lr > 1 Then
testingData.Range("e2", testingData.Range("e" & testingData.Rows.Count).End(xlUp)).EntireRow.Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
Sheets(ar(i)).Columns.AutoFit
End If
Next i
testingData.[e2].AutoFilter
0
MsBluebird Posts 7 Registration date Thursday July 25, 2019 Status Member Last seen July 26, 2019
Jul 25, 2019 at 12:18 PM
0
You need another closing ) to define the range! And you need to apply the same range construction to thw second range of e.

0
Blocked Profile
Jul 25, 2019 at 11:18 AM
Do it like this. Make the range and get over the error. Then you start constructing the range with variables. If you do not know what values mean, then read about them, or dont use code you have cut and pasted.
0
MsBluebird Posts 7 Registration date Thursday July 25, 2019 Status Member Last seen July 26, 2019
Jul 25, 2019 at 11:57 AM
Thank you for your comments. I pulled my code from a response on this forum, which was exactly what I wanted to do. I have tried forum after forum and code after code to get to this point. I am not an expert, which is why I needed someone to look at my task. Happily, I now feel stupid, in a help forum of all places. Perhaps someone who is patient and has the desire to help and the will to follow your tag line will be able to address this issue.
0
Have ypu tried to manually make the range? Try that, then change it to a variable.

I am intending to help, and I have been giving advise on how to make it your code. Please post the link to the article so I can have a reference to where you begun!
0
I see it now!

OK, I added in two lines:


Dim testingData As Worksheet
Set testingData = ThisWorkbook.Sheets("testingData")


So that the sheet is initialized. It runs for me. If you get an error, the tab names are incorrect.

Sub TransferData()
Dim ar As Variant
Dim i As Integer
Dim lr As Long

'I added this VVVVVVVVVVVVV
Dim testingData As Worksheet
Set testingData = ThisWorkbook.Sheets("testingData")
'make certain there is a sheet called "testingData"
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
ar = Array("1 ADJUVANT", "2 2,4-D MANY CAS #", "16 ALDICARB", "60 CHLOROTHALONIL", "97 ENDOTHALL", "146 GLYPHOSATE")
'make certain your tabs are named exaclty as the array above!
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 0 To UBound(ar)
testingData.Range("e2", ThisWorkbook.Worksheets("testingData").Range("e" & ThisWorkbook.Worksheets("testingData").Rows.Count).End(xlUp)).AutoFilter 1, ar(i), 7, , 0
lr = testingData.Range("e" & Rows.Count).End(xlUp).Row
If lr > 1 Then
testingData.Range("e2", testingData.Range("e" & testingData.Rows.Count).End(xlUp)).EntireRow.Copy Sheets(ar(i)).Range("A" & Rows.Count).End(3)(2)
Sheets(ar(i)).Columns.AutoFit
End If
Next i
testingData.[e2].AutoFilter
End Sub





0
MsBluebird Posts 7 Registration date Thursday July 25, 2019 Status Member Last seen July 26, 2019
Jul 25, 2019 at 01:00 PM
Oh THANK YOU so very much!!!!! I am deeply grateful for your assistance!!! I spent years collating data by hand before I learned to use worksheet formulas. They were faster, but excel was unstable and often froze.

I have one more question. All the data transferred successfully row by row onto the labeled tabs, however, the rows are all scrunched up. I have to copy and paste to another sheet to actually see the data. Do you know where in the code the command to hide the data might be? I have additional data manipulations to make.

Once again, my deepest thanks for your kind assistance!
0
MsBluebird Posts 7 Registration date Thursday July 25, 2019 Status Member Last seen July 26, 2019
Jul 25, 2019 at 01:21 PM
Now that I have un-hid the data, it looks like all the data was copied to all of the named tabs. I have 330+ chemicals in my databases, but I really only want data on the six listed chemicals. The data that I want to use for sorting resides in column E of the testingData worksheet. If you have any thoughts on this, I would be grateful!
0
You could scrub line by line and see if the value is in that same array, and if not delete the whole line. Does that sound right?

So you already have the array. Now we just count the number of lines on testingdata, and loop through each row looking at the value in cell E(x). If the value in E (x) is not an array element, we highlight the whole row of (x). And delete it.

Sound right?
0
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259
Jul 26, 2019 at 12:50 AM
Hello MsBluebird,

Further to what ac3mark has shown you, the code could be trimmed down a little as follows:-


Sub TransferData()

        Dim ar As Variant, i As Integer, sh As Worksheet
        Dim ws As Worksheet: Set ws = Sheets("Testing Data") '---->Sets a value to the variable ws.
        
        ar = Array("1 ADJUVANT", "2 2,4-D MANY CAS #", "16 ALDICARB", _
        "60 CHLOROTHALONIL", "97 ENDOTHALL", "146 GLYPHOSATE")

Application.ScreenUpdating = False

For i = 0 To UBound(ar) '---->Looping from the bottom of the array to the top.

        Set sh = Sheets(ar(i)) '---->Sets a value to the variable sh.
        sh.UsedRange.Offset(1).Clear '---->Clears the destination sheets of data (except headings)ready for new data.
        
        With ws.[A1].CurrentRegion
                .AutoFilter 5, ar(i)  'Filters the data set on Column E to find the array values.
                .Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(3)(2) '---->Copy/paste to the destination sheets.
                .AutoFilter '---->Turns the autofilter off.
                sh.Columns.AutoFit '---->Autofits the column widths in the destination sheets.
        End With '---->Closes off the With statement.
Next i '---->Moves onto the next array item.

Application.ScreenUpdating = True

End Sub


I've added in some notes (in green font) to help you understand what the code does.

From your opening post:-

problem is in this row. To be fair, I don't know what the 7,, 0 means 


The '7' is the enumeration for xlFilterValues. The '0' is the enumeration for the filter visible dropdowns to remain off (0=False).

Check that all spelling/punctuation (inc. spaces) is exactly the same so that tab names match exactly to the array values. Also ensure that the "Testing Data" sheet name matches exactly to its variable in the code.

I've attached a little example at the following link just to show you how this code works:-

http://ge.tt./678jGGx2

Click on the "RUN" button to see it work.

I hope that this helps.

Cheerio,
vcoolio.
0
MsBluebird Posts 7 Registration date Thursday July 25, 2019 Status Member Last seen July 26, 2019
Jul 26, 2019 at 10:05 AM
Oh, oh, oh!!!! How wonderful!!! everything works as needed to separate my products!! I am deeply grateful for your kind explanations and thoughtful insights. I will use the MsBluebird workbook you provided as a springboard to continuously improve the speed and efficiency of this complex project. Kindest regards.
0
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259
Jul 26, 2019 at 06:34 PM
You're welcome MsBluebird.
I'm glad that we were able to assist. Good luck with your project.

Cheerio,
vcoolio.
0
Blocked Profile
Jul 26, 2019 at 06:41 PM
TY vcoolio!

I am glad you have shared an even trimmer version! I did not look up the xlFilterValues switches, so I could not expand on them! I try to write simple code, without all of the .NET "sexiness" in there! Then the OP can learn. You have helped out in the learning, and I appreciate that!
0
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259
Jul 26, 2019 at 06:48 PM
Thumbs up Mark!
[Can't use an emoji because Admin won't give us any to amuse ourselves with ;-) ]!
0