Copying a Row Based on Coloumn Contents

Tizek · Aug 18, 2014

Hi All,

Firstly im sorry if this has been asnwered elsewhere. i have very limited experiance with excel and macros.
I can do lookups with sharepoint and infopath, but havent got a clue about excel.

Basicaly we have 1 database (so to speak) worksheet.
What im looking for is a macro that searches this sheet, depending on a cell value and then copys the entire row to another worksheet.

What i dont want it to do however is produce duplicates on the seperate tab if this makes sense.

The below link, is the spreadsheet,
https://dl.dropboxusercontent.com/u/65121181/Membership.xls

The Main Database tab would be TKDEL_Membership,
So we would fill in what we need to, what we would then like is If Group - Contains Future TKD as an example
It would then copy that row of data to the Future TKD tab.

All in all, off top of my head there is about 26 groups, so this would 26 tabs so the macro would need obviously search these, and do as described.

If someone could help me that would be super dooper.

DocAElstein · Aug 18, 2014

Hi,
. I am abeginner, but it sounds fairly easy. I am practicing this sort of thing so I could give it a try.
. But.. Do you mean if group or if club ?? - I see no Future TKD in group

Tizek · Aug 18, 2014

Hi doc thanks for the reply

it would be column club that these belong to,

so in all there's 26 Clubs which need to go on their respective named tab.
hope that makes sense

DocAElstein · Aug 18, 2014

Tizek said:
Hi doc thanks for the reply

it would be column club that these belong to,

so in all there's 26 Clubs which need to go on their respective named tab.
hope that makes sense

Ok, no prob. I understand.
I'll get on it, and send the file back with macro in it Today or Tomorrow - I'm on a different time scale here

Alan
Bavaria

Tizek · Aug 18, 2014

That's much appreciative sir thank you very much

Alan_P · Aug 18, 2014

Tizek said:
so in all there's 26 Clubs which need to go on their respective named tab. hope that makes sense

Hi Alan_S, looks interesting this one! Hope you don't mind if I have a go as well?

Hi Tizek, There's a lot of variance in the club names, is it safe to assume that, for example, "Blackpool", "Blackpool Tkd" and "Blackpool Taekwondo" are the same club?

If that is the case I've got a count of 22 clubs (with "Dragon Spirit" & "Dragon Northampton" being one club and "Dragon TKD" being another) but your post says 26? Is there some that look the same but aren't?

Like are "FUTURE TKD" and "FUTURE TKD LIONS" the same club?

Cheers,
Alan.

Alan_P · Aug 18, 2014

On a side note; I'm not sure if it's wise to post that many personal details on the internet?

DocAElstein · Aug 18, 2014

Hi Tizek,
. Before I go any further, I‘ll show You what I have up until now, as I was not too sure exactly what you wanted with regard to

Tizek said:
……….What i dont want it to do however is produce duplicates on the seperate tab if this makes sense…….

. Also, like Alan_P, I was a bit confused with the Team name inconsistencies. But I got over that one: The file that I send back to you now only has 3 teams for demonstration Purposes. However to add a new Team you simply open a new Tab and give it the Team Name: Note It is important that it is exactly the team name as spelt in column Club in Sheet 1 (TKDEL_Membership). So copy the name from that column and paste it in the Tab name. Then when you run the code, it automatically takes account of the new team. You can keep adding teams as many as you like (within reason!-26 is certainly no problem!).

. There are lots of easy tidying up that can be done to the code, once I know if it is OK and a bit more of exactly what you want.
. Take a look at what I have done so far and Let me know how you get on. I’ll (We’ll) take it then further when we Know exactly what you want.

. Here is the code which I have put in Sheet1 (TKDEL_Membership) Module.

Option Explicit 'Not necerssary but a good idea Sub SimpleSortOfSort1() Dim HeadingNumber As Byte, HeadingNumberMax As Byte ' Define variable as integer up to 255 Let HeadingNumberMax = Worksheets("TKDEL_Membership").Cells(1, Columns.Count).End(xlToLeft).Column 'Get Maximun Heading number Dim TKDEL_MembershipRowMax As Integer 'Define maximum Row in sheet 1 as integer up to 32,767 Let TKDEL_MembershipRowMax = Worksheets("TKDEL_Membership").Cells(Rows.Count, 1).End(xlUp).Row 'get maximum rows for Sheet1 Dim TKDEL_MembershipRow As Integer Dim NumberOfTeams As Byte Let NumberOfTeams = Worksheets.Count 'Get number of worksheets. Dim WorksheetNumber As Byte Dim TeamName As String ' Define Team name as a string variable Dim TeamWorksheetRow As Integer Let TeamWorksheetRow = 1 For WorksheetNumber = 2 To NumberOfTeams 'Go through each team... TeamName = Worksheets(WorksheetNumber).Name ' ...get it's name... Let TeamWorksheetRow = 1 ' Start at row 1 in team worksheet(each time) For TKDEL_MembershipRow = 2 To TKDEL_MembershipRowMax Step 1 '... go through every Row in First sheet If Worksheets("TKDEL_Membership").Cells(TKDEL_MembershipRow, 7).Value = TeamName Then '..check for team name match Let TeamWorksheetRow = TeamWorksheetRow + 1 ' goto next Row in team Worksheet For HeadingNumber = 1 To HeadingNumberMax Step 1 Worksheets(WorksheetNumber).Cells(TeamWorksheetRow, HeadingNumber).Value = Worksheets("TKDEL_Membership").Cells(TKDEL_MembershipRow, HeadingNumber).Value 'Copy entire row Next HeadingNumber Else ' Otherwise if no match..... ' Do nothing! End If Next TKDEL_MembershipRow ' go to next row in sheet 1 untill all rows are done... Next WorksheetNumber ' then go to next Team sheet End Sub 'SimpleSortOfSort1()

. Here are two files, one before and one after running the macro

http://snk.to/f-ctpadfik
FileSnack | Easy file sharing

. For now the main thing is to see if it comes out roughly how you want it and suggest any improvements.

Be in touch tomorrow
Alan

………………………………………………………………………………………………….

Hi Alan_P,

Alan_P said:
Hi Alan_S, looks interesting this one! Hope you don't mind if I have a go as well?

. I guess it is fair game for everyone to try? (Just hope a profi Puts us right in the end!!) Give it a go, or take it further- It is bed time here now so I’ll have a look how you got on tomorrow sometime.

God Night, Gute nacht

DocAElstein · Aug 18, 2014

Hi Tizek,
. Before I go any further, I‘ll show You what I have up until now, as I was not too sure exactly what you wanted with regard to

Tizek said:
……….What i dont want it to do however is produce duplicates on the seperate tab if this makes sense…….

. Also, like Alan_P, I was a bit confused with the Team name inconsistencies. But I got over that one: The file that I send back to you now only has 3 teams for demonstration Purposes. However to add a new Team you simply open a new Tab and give it the Team Name: Note It is important that it is exactly the team name as spelt in column Club in Sheet 1 (TKDEL_Membership). So copy the name from that column and paste it in the Tab name. Then when you run the code, it automatically takes account of the new team. You can keep adding teams as many as you like (within reason!-26 is certainly no problem!).

. There are lots of easy tidying up that can be done to the code, once I know a bit more exactly what you want.
. Take a look at what I have done so far and Let me know how you get on. I’ll (We’ll) take it then further Until we have exactly what you want.

. Here is the code which I have put in Sheet1 (TKDEL_Membership) Module.

Option Explicit 'Not necerssary but a good idea Sub SimpleSortOfSort1() Dim HeadingNumber As Byte, HeadingNumberMax As Byte ' Define variable as integer up to 255 Let HeadingNumberMax = Worksheets("TKDEL_Membership").Cells(1, Columns.Count).End(xlToLeft).Column 'Get Maximun Heading number Dim TKDEL_MembershipRowMax As Integer 'Define maximum Row in sheet 1 as integer up to 32,767 Let TKDEL_MembershipRowMax = Worksheets("TKDEL_Membership").Cells(Rows.Count, 1).End(xlUp).Row 'get maximum rows for Sheet1 Dim TKDEL_MembershipRow As Integer Dim NumberOfTeams As Byte Let NumberOfTeams = Worksheets.Count 'Get number of worksheets. Dim WorksheetNumber As Byte Dim TeamName As String ' Define Team name as a string variable Dim TeamWorksheetRow As Integer Let TeamWorksheetRow = 1 For WorksheetNumber = 2 To NumberOfTeams 'Go through each team... TeamName = Worksheets(WorksheetNumber).Name ' ...get it's name... Let TeamWorksheetRow = 1 ' Start at row 1 in team worksheet(each time) For TKDEL_MembershipRow = 2 To TKDEL_MembershipRowMax Step 1 '... go through every Row in First sheet If Worksheets("TKDEL_Membership").Cells(TKDEL_MembershipRow, 7).Value = TeamName Then '..check for team name match Let TeamWorksheetRow = TeamWorksheetRow + 1 ' goto next Row in team Worksheet For HeadingNumber = 1 To HeadingNumberMax Step 1 Worksheets(WorksheetNumber).Cells(TeamWorksheetRow, HeadingNumber).Value = Worksheets("TKDEL_Membership").Cells(TKDEL_MembershipRow, HeadingNumber).Value 'Copy entire row Next HeadingNumber Else ' Otherwise if no match..... ' Do nothing! End If Next TKDEL_MembershipRow ' go to next row in sheet 1 untill all rows are done... Next WorksheetNumber ' then go to next Team sheet End Sub 'SimpleSortOfSort1() 

. Here are two files, one before and one after running the macro

FileSnack | Easy file sharing
FileSnack | Easy file sharing

. For now the main thing is to see if it comes out roughly how you want it and suggest any improvements.

Be in touch tomorrow
Alan

………………………………………………………………………………………………….

Hi Alan_P,

Alan_P said:
Hi Alan_S, looks interesting this one! Hope you don't mind if I have a go as well?

. I guess it is fair game for everyone to try? (Just hope a profi Puts us right in the end!!) Give it a go, or take it further- It is bed time here now so I’ll have a look how you got on tomorrow sometime.

God Night, Gute nacht

Alan_P · Aug 18, 2014

*Forgot to mention that I'm also new to VBA, so this is a learning experience for me

OK, here's what I got, you'll have to do a few things first;

1) Make a copy of your workbook to test the following in.

2) Delete all tabs except the main sheet. You can use this code to make it quick (used extensively during testing

):-

Code:

Sub DeleteTabs()
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "TKDEL_Membership" Then
    ws.Delete
    End If
Next
Application.DisplayAlerts = True
End Sub

3) Go through your list of Clubs and name each one the same thing (Unfortunately I don't have a quick way of doing this

) (Apart from maybe using autofilter to select all the ones that are the same club then enter the exact same name for each).

4)
Run this code (It will take a few seconds):-

Code:

Public Sub BigOne()

Application.ScreenUpdating = False

Dim LastUngRow As Long
Dim i As Long
Dim x As Long
Dim z As Long
Dim n() As String

Worksheets.Add(After:=Worksheets(1)).Name = "Unique1"

Sheets("TKDEL_Membership").Range("G1:G1310").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Unique1").Range("A1"), Unique:=True

LastUnqRow = Sheets("Unique1").Range("A" & Rows.Count).End(xlUp).Row
LastMainRow = Sheets("TKDEL_Membership").Range("G" & Rows.Count).End(xlUp).Row

For i = LastUnqRow To 2 Step -1
ReDim n(i)
    If Sheets("Unique1").Cells(i, 1).Text <> "" Then
        n(i) = Sheets("Unique1").Cells(i, 1).Text
        Worksheets.Add(After:=Worksheets(1)).Name = n(i)
        Sheets("TKDEL_Membership").Range("A1").EntireRow.Copy Sheets(n(i)).Range("A1")
    
        z = 2
        For x = 2 To LastMainRow
            If Sheets("TKDEL_Membership").Cells(x, "G").Text = n(i) Then
                Sheets("TKDEL_Membership").Cells(x, "G").EntireRow.Copy Sheets(n(i)).Range("A" & z)
                Sheets(n(i)).Columns("A:AM").AutoFit
                z = z + 1
            End If
        Next x
    End If
Next i

Application.DisplayAlerts = False
Sheets("Unique1").Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

What this (should & is tested to do) is find each unique club name in column G, make a new sheet with that name and copy all rows with that name to the new sheet. (it makes sense in my head anyway

)

This is the end result I came up with:

https://drive.google.com/file/d/0B867a8TcsKV6cTM2NDBYZDh1X1U/edit?usp=sharing

Cheers,
Alan.

Copying a Row Based on Coloumn Contents

Tizek

New Member

Excel Facts

DocAElstein

Banned user

Tizek

New Member

DocAElstein

Banned user

Tizek

New Member

Alan_P

Well-known Member

Alan_P

Well-known Member

DocAElstein

Banned user

DocAElstein

Banned user

Alan_P

Well-known Member

Similar threads

Forum statistics

Share this page

Copying a Row Based on Coloumn Contents

New Member

Excel Facts

Banned user

New Member

Banned user

New Member

Well-known Member

Well-known Member

Banned user

Banned user

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock