Copy rows to other sheets based on value in column

Question

Previous Topic Next Topic

Copy rows to other sheets based on value in column

[Solved/Closed]

Report

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: 1318
Registration date: Thursday July 24, 2014
Status: Moderator
Last seen: September 20, 2021

- 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?

Copy rows to other sheets based on value in column
Copy rows to other sheets based on value in column ✓ - Forum - Excel
Copy rows to other sheets based on value in column ✓ - Forum - Excel
Excel move row to another sheet based on cell value without macro ✓ - Forum - Excel
Google sheets move row to another sheet based on cell value ✓ - Forum - Excel
Excel copy row to another sheet based on cell value ✓ - Forum - Excel

4 replies

Ask a question

Blocked Profile · Answer 1 · 2019-07-25T09:54:28-0400

Answer 1 / 4

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.

Report

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

Report

MsBluebird

Posts: 7
Registration date: Thursday July 25, 2019
Status: Member
Last seen: July 26, 2019

Jul 25, 2019 at 12:18 PM

Thank you.
The link is https://ccm.net/forum/affich-972900-copy-rows-to-other-sheets-based-on-value-in-column

Blocked Profile · Answer 2 · 2019-07-25T11:17:16-0400

Answer 2 / 4

Blocked Profile
Updated on Jul 25, 2019 at 11:19 AM

You need another closing ) to define the range! And you need to apply the same range construction to thw second range of e.

Report

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.

Report

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.

Report

Blocked Profile
Updated on Jul 25, 2019 at 12:10 PM

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!

Blocked Profile · Answer 3 · 2019-07-25T12:43:44-0400

Answer 3 / 4

Blocked Profile
Updated on Jul 25, 2019 at 04:52 PM

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

Report

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!

Report

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!

Report

Blocked Profile
Updated on Jul 25, 2019 at 04:53 PM

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?

vcoolio · Answer 4 · 2019-07-26T00:50:44-0400

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.

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.
You're welcome MsBluebird.
I'm glad that we were able to assist. Good luck with your project.

Cheerio,
vcoolio.
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!
Thumbs up Mark!
[Can't use an emoji because Admin won't give us any to amuse ourselves with ;-) ]!

Copy rows to other sheets based on value in column

4 replies

Your reply

Subscribe To Our Newsletter!