VBA Loop

[wtom0412]

Hi All,

I have managed to do some code that will find a specific value in a column and loop through until it finds all instances of that value then copy it / them to a specific TAB, but it is really limiting, as I want the user to be able to use unique identifiers in column K (I can post the code if you like, but I don't think I am on the right track).

What I would love to be able to do is loop through a column (K), search for the next unique value and copy them to a new TAB.

For example, loop through Sheet 1 Column K until a value is found (can be any combination of a number followed by a letter - example "1A" or "24F" or "4E"). Once found, create a new TAB (using a template) and copy the row from Sheet 1 to Row 10 on the New Tab, then rename the newly created TAB the same name as value found (in this instance "1A"). Continue the loop to see if another "1A" is found, if so, copy that line to Row 11 of the new "1A" TAB. Continue through column K until no more 1A's are found.

Continue the loop until the the next Unique value is found (lets say "4E") - repeat above.

Repeat above until all unique values have been found and then quit.

I hope this makes sense?

If any one can help, I would be greatly appreciative.

Cheers

WT

 

[Fluff]

How about

Sub wtom0412()
   Dim Cl As Range
   Dim Ws As Worksheet
   Dim Ky As Variant
   
   Set Ws = Sheets("Sheet1")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("K2", Ws.Range("K" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Ky In .Keys
         Ws.Range("A1:K1").AutoFilter 11, Ky
         Sheets.Add(, Sheets(Sheets.Count)).Name = Ky
         Ws.AutoFilter.Range.SpecialCells(xlVisible).EntireRow.Copy Range("A10")
      Next Ky
      Ws.AutoFilterMode = False
   End With
End Sub

Assumes headers are in row1

 

[baitmaster]

Hi, whenever you want to work with unique values, you should consider using a scripting dictionary. This can be used to create a virtual list that you can then process in any way you like. The following example should hopefully demonstrate it's potential and perhaps you can use this for your needs

Option Explicit

Sub createDictionary()
' this sub creates a dictionary of unique values
' it requires a Reference to "Microsoft Scripting Runtime" (Tools > References > ...)


' create dictionary object, turn case-sensitivity off
Dim dict As Scripting.Dictionary: Set dict = New Scripting.Dictionary
dict.CompareMode = TextCompare


' pass all unique values into it
Dim cl As Range, str As String
For Each cl In Range("K:K").SpecialCells(xlCellTypeConstants)
    str = cl.Value
    dict(str) = dict(str) & "|" & cl.Row ' this example captures all rows containing the dictionary value
Next cl


' write all unique values to the VB Editor "Immediate" window
Dim k
For Each k In dict.Keys
    Debug.Print k, dict(k)
Next k


End Sub

 

[wtom0412]

Hi Fluff,

Thank you so much, perfect!!

Cheers, WT

 

[wtom0412]

Hi Baitmaster,

Thank you, I love this code. There's a million things I can do with this!!

Cheers, WT

 

[Fluff]

You're welcome & thanks for the feedback