Copying a Row Based on Coloumn Contents

[Tizek]

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.

 

[Tizek]

Jesus mega booboisie I thought if completely cleared tht
can I ask that you delete that copy please I thought I'd removed all the data

 

[Tizek]

Hi Both,

The macros are almost there thank you very much, is there a way that we can update deleted rows from the extra created tabs?
for example if these are accidently deleted, the macro would recreate those particular entries?

Also is it possible to attach these to a button in excel?

 

[Alan_P]

Jesus mega booboisie

That statement made me chuckle
I've deleted the file I added.

 

[Alan_P]

is there a way that we can update deleted rows from the extra created tabs?
for example if these are accidently deleted, the macro would recreate those particular entries?

My macro works for initial creation of the new tabs not to update them with new entries (this would require a seperate macro), but if you run the "DeleteTabs" macro and then the "BigOne" macro again it will create a fresh 'dump' from the main tab, but this would delete any and all changes made within the club tabs.

Also is it possible to attach these to a button in excel?

you can insert an ActiveX command button from the developer tab, then right click on it and select view code, then ensuring that "DeleteTabs" macro and "BigOne" macro are in a module, insert this code;

 Private Sub CommandButton1_Click()
DeleteTabs
BigOne
End Sub

or...You can just insert a shape and then right click and assign macro.

 

[DocAElstein]

Morning, Guten Morgen Both!

Alan_P
. Wow, Super!. –Your Code does the extra bits I wanted to but did not know how. I worked through your code and learnt a lot. Thanks. (I had no idea, for example, .about the Copy with Filter stuff and so that is why I made/ gave a shortened File back after giving up typing In and checking the team names manually!!!)
. Two small follow up Questions.
. Can you explain the logic behind using an array for the team Name , n(i). And why it is initially the size equal to the unique team numbers +1, and then ends up at the end of the loop to be re dimensioned to very small, (with 2 elements I think at the end?). The code runs the same with the team Name, n as a simple string?
. Is there any special reason why you use .Text and not just .Value when putting in the team name in The appropriate Tab
Thanks.
Alan_E
……………………………………………………………..

Hi Tizek,
. Alan_P’s Macro does wot mine did, just a lot better and does it for the complete file. So if you are happy with the results then stick with that one.
. The files I returned did not have all the data in, but I just deleted them anyway, so no worries about that one. (And although I am English, I’m probably stuck out in this cold corner of Germany for the rest of my life, so I have no interest in anybody’s name or Address in England!)
Alan

 

[Alan_P]

Thanks Alan_E I learnt a lot doing it too, that's the most complicated code I've done to date!

That's the first time I'd seen the copy with advanced filter as well, I did a google search for "Excel VBA extract unique values from a column" and it was in the first thread I clicked on, Lucky! When I looked it up there is another part you can add to it "CriteriaRange:=Range("Criteria")" so I thought I could use it to extract each of the club names instead of looping through the rows but I've not been able to get it to work, I might post a separate thread on it to see if someone can explain the workings of it as I think it would speed up the macro dramatically!, I searched for ages and couldn't find anything.

Oh yeah well spotted! I didn't realise I didn't need to use the array... in my first version of the code I was calling each sheet like Sheets(n(1)).Range("A1"), Sheets(n(2)).Range("A1"), ect... but then I realised I could use the "i" loop to do that and then nest the "x" loop inside that to copy the cells, never twiged that the array wasn't needed anymore (would have saved me a lot of hassle if I had!).
At first I had the array defined as "n(40)" which was the amount of unique clubs, then I though if he reduces that to 22 what would happen? so I tested that and I got stuck in an infinite loop so I dim'd the array as undefined "n()", this gave me an error (I think subscript out of range) so I looked that up and found that the "Redim" was the answer. At this point it was 1am, the code was working and I was due in work for 7am so I posted and went to bed

In this instance, no particular reason for using .Text other than that's what it was in my other macro I copied it from In the other macro I used it because the cell was a date and I wanted the actual text not the numerical date value.

I've been playing with some extra features like freezing the top row on each sheet, changing all the font to Calibri and alternating a light fill colour on each row to make it easier to read, but they all make the macro super super slow!

Cheers,
Alan.

P.s. sorry for rambling

 

[DocAElstein]

Thanks Alan_E I learnt a lot doing it too, that's the most .............
...At this point it was 1am, the code was working and I was due in work for 7am so I posted and went to bed

.............................sorry for rambling

.....had the feeling you did a long VBA shift yesterday!

.... Its not rambling- It's good feedback!

 

[Alan_P]

.....had the feeling you did a long VBA shift yesterday!

Haha yeah was long but enjoyable I get a train of thought in my head and don't want to stop because I know I'll be lost when I come back to it!

 

[Alan_P]

I did some serious digging on the advance filter and have found that the only thing (for me) that it's useful for is extracting unique values. AutoFilter combined with SpecialCells on the other hand is an amazing feature! Seriously speeds up the code! I've coloured that section blue...

I've finished playing with the extra features (Red) & added the "delete other tabs" code (Purple) as this is needed for the code to work... here's the result;

Public Sub BigOneV6()

Application.ScreenUpdating = False

Dim LastUngRow As Long
Dim i As Long
Dim x As Long
Dim z As Long
Dim n As String
Dim ws As Worksheet

[COLOR=#4b0082]Application.DisplayAlerts = False
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name <> "TKDEL_Membership" Then
    ws.Delete
    End If
Next
Application.DisplayAlerts = True[/COLOR]

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

    If Sheets("Unique1").Cells(i, 1).Text <> "" Then
        n = Sheets("Unique1").Cells(i, 1).Text
        Worksheets.Add(After:=Worksheets(1)).Name = n
            
[COLOR=#0000ff]        With Sheets("TKDEL_Membership")
            .UsedRange.AutoFilter Field:=7, Criteria1:=n
            .UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(n).Range("A1")
        End With[/COLOR]
        
        With Sheets(n).UsedRange
            .WrapText = False
            .Font.Name = "Calibri"  [COLOR=#ff0000]'changes all font to Calibri. Delete this line if not wanted[/COLOR]
            .Font.ColorIndex = 0    [COLOR=#ff0000]'Changes all font colour to black. Delete this line if not wanted[/COLOR]
            .Font.Bold = False      [COLOR=#ff0000]'Removes all BOLD. Delete this line if not wanted[/COLOR]
            .Columns.AutoFit
        End With
        
        Sheets(n).Activate          [COLOR=#ff0000]'1'[/COLOR]
        With ActiveWindow           [COLOR=#ff0000]'2'[/COLOR]
            .SplitRow = 1           [COLOR=#ff0000]'3'This group freezes top row of each sheet,[/COLOR]
            .FreezePanes = True     [COLOR=#ff0000]'4'Delete line 1-5 if not wanted[/COLOR]
        End With                    [COLOR=#ff0000]'5'[/COLOR]
        
       [COLOR=#ff0000] ''' From here to XXX, colours every second row [/COLOR][COLOR=#008000]light green[/COLOR]
        Dim Counter As Integer
        For Counter = 2 To Sheets(n).UsedRange.Rows.Count
            If Counter Mod 2 = 1 Then
                With Sheets(n).UsedRange.Rows(Counter).Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent3
                    .TintAndShade = 0.799981688894314
                    .PatternTintAndShade = 0
                End With
            End If
        Next
       [COLOR=#ff0000] '''XXX - Delete this group if not wanted[/COLOR]
        
    End If
Next i

Sheets("TKDEL_Membership").AutoFilterMode = False

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

Application.ScreenUpdating = True

End Sub

Cheers,
Alan.

 

[DocAElstein]

I did some serious digging on ............................

Hi Alan_P!!!<o></o>
. Another useful improvement! Great

. ---- I almost missed this last additionfrom you!!?!? – (I got no notification E-mail – probably because you replied sosoon after your Reply before! - Have tobe careful about that: Maybe the OP did not see it. – Well at least he has another chance now – Lucky I just coincidentally trippedover the thread again while I was digging backwards to find any Threads that I’mcapable of answering- I still have to look a long way sometimes to find one!!!)------<o></o>
<o> </o>
.. Yeah, I see yourpoint: That

[COLOR=#002060][FONT=Verdana]            .UsedRange.AutoFilter Field:=7, Criteria1:=n[/FONT][/COLOR]
[COLOR=#002060][FONT=Verdana]           .UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(n).Range("A1")<o:p></o:p>[/FONT][/COLOR]
[COLOR=#0070c0][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=#0070c0][FONT=Verdana]<o:p> </o:p>[/FONT][/COLOR]
[COLOR=#00b050][FONT=Verdana]     'Then later turn the thing back off later with<o:p></o:p>[/FONT][/COLOR]
[COLOR=#002060][FONT=Verdana]Sheets("TKDEL_Membership").AutoFilterMode = False<o:p></o:p>[/FONT][/COLOR]

<o></o>
<o> </o>
<o> </o>
. stuff is a powerful thingand very useful for my “sort of sorting”, thanks for digging it out. <o></o>
<o> </o>
. I get the idea of it now – makes visiblebased on the criteria only the stuff you want, then combine it with SpecialCells to just copy that wotyou see, (and then send it or whatever).<o></o>
. ( Idid notice that it works the same without the .SpecialCells(xlCellTypeVisible) bit, - but that mayjust be Excel “guessing wot you want” as it does, that is to say it copies bydefault wot is visible?- not too sure on that one yet.) <o></o>
<o> </o>
.. keep digging stuffout or Googleing or whatever. <o></o>
<o> </o>
<o> </o>
.Alan<o></o>
<o> </o>
(P.s. You probably know that greenwhite line formatting thing is up in the Ribbon ab XL2007 so you can select it rather than use a macro? – But good to know anyway –I’ve got lots of Excel versions and I was thinking of standardizing to XL 2003and using macros to do any new bits from 2007 2010 that I need. – One thing I thinkI will have to give up on though is “tricking” 2003 into giving me as manycolors as ab 2007 – think I am on that one)<o></o>