Solved Macro to copy random rows keeping unique data from a 2nd Col

July 6, 2016 at 20:19:37
Specs: Windows 8
I have a list of unique file numbers in Column A and a Name associated with each file number in Col N.
There are 5000 rows of Data. I would like to pull a random sampling of the file numbers based on the following criteria:
- 10% of the total File Numbers in Col A (500 File Numbers)
- Pull at least 1 File Number for each Name (There are 100 unique Names)
- The final 10% can contain duplicate Names but needs to contain at least one File Number for each Name

SO, when it's all said and done, Sheet 2 should contain 500 rows of data containing 100 unique Names.

Can this be done?


See More: Macro to copy random rows keeping unique data from a 2nd Col

Report •


✔ Best Answer
July 13, 2016 at 12:53:30
This code will pull at least 1 copy of each unique name and add any extra rows if required. The code will warn the user if the number of unique Names exceeds 10% of the total entries.

Overview:

1 - The code first copies Sheet1 and adds it to the end of the workbook.
2 - It then sorts the new sheet by Name (Column O).
3 - It then determine which rows contain the first and last entry of the first Name.
4 - Once it knows the starting and ending rows, the code generates a random number within that range and copies that single row to Sheet2.
5 - Once the row has been copied, the code deletes the Name in Column 0, leaving an empty cell. This ensures that any row that has already been randomly selected will not be selected again, as explained in Step 7.
6 - Steps 3-5 are repeated until one occurrence of each unique name has been copied and deleted.
7 - The code then resorts Column O to move all of the blank cells to bottom of the list. This allows the code to work with the list of remaining Names, i.e. Names that have not yet been randomly selected.
8 - The code then determines 10% of the total entries in Sheet1 as well as the number of unique Names that have already been copied to Sheet2. Using these values, the code determines how many "extra" rows it needs to copy to reach the required 10%.
9 - The code then builds an array of "extra" random row numbers from the remaining Names in Column O of the new sheet.
10 - Once the array of random row numbers is built, the loops through the array, copying the rows from the new sheet to Sheet2.
11 - Finally, the code deletes the new Sheet.

Sub Random10_EveryName()
Randomize 'Initialize Random number seed

   Application.ScreenUpdating = False

'Copy Sheet1 to new sheet
   Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)

'Clear old data in Sheet 2
  Sheets(2).Cells.ClearContents
  
'Determine Number of Rows in Sheet1 Column A
  numRows = Sheets(Sheets.Count).Cells(Rows.Count, _
              "A").End(xlUp).Row
              
'Sort new sheet by Column O
  Sheets(Sheets.Count).Cells.Sort _
   key1:=Sheets(Sheets.Count).Range("O1:O" & numRows), _
   order1:=xlAscending, Header:=xlYes

'Initialize numNames & startRow variable
  numNames = 1
  startRow = 2

'Loop through sorted names, count number of current Name
    For nameRows = startRow To numRows
      If Sheets(Sheets.Count).Cells(nameRows, "O") = _
         Sheets(Sheets.Count).Cells(nameRows + 1, "O") Then
           numNames = numNames + 1
      Else:
        endRow = startRow + numNames - 1

'Generate Random row number within current Name Group
           nxtRnd = Int((endRow - startRow + 1) * _
                         Rnd + startRow)

'Copy row to Sheet2, Delete copied Name
         dstRow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
           Sheets(Sheets.Count).Rows(nxtRnd).EntireRow.Copy _
             Destination:=Sheets(2).Cells(dstRow, 1)
         Sheets(Sheets.Count).Cells(nxtRnd, "O").ClearContents
        
'Set Start Row for next Name Group, reset numNames variable
        startRow = endRow + 1
        numNames = 1
      End If
    Next

'Sort new sheet by Column O
    Sheets(Sheets.Count).Cells.Sort _
      key1:=Sheets(Sheets.Count).Range("O1:O" & numRows), _
      order1:=xlAscending, Header:=xlYes
   
'Determine Number of Remaining Names in new sheet Column O
    numNamesleft = Sheets(Sheets.Count).Cells(Rows.Count, _
              "O").End(xlUp).Row - 1
              
'Determine 10% of total entries from Sheet1
    percRows = _
        WorksheetFunction.RoundUp((numRows - 1) * 0.1, 0)
        
'Determine how many extra rows are needed to reach 10% of total
    unqNames = Sheets(2).Cells(Rows.Count, _
              "O").End(xlUp).Row - 1
    extRows = percRows - unqNames
    
'Warn user if number of Unique Names exceeds 10% of Total Entires
      If extRows < 0 Then
        MsgBox "Number of Unique Names Exceeds 10% of Total Entries"
'Delete new sheet
          Application.DisplayAlerts = False
            Sheets(Sheets.Count).Delete
          Application.DisplayAlerts = True
        Exit Sub
      End If
      
'Extract Random entries from remaining names to reach 10%
'
'Allocate elements in Array
        ReDim MyRows(extRows)
'Create Random numbers and fill array
         For nxtRow = 1 To extRows
getNewRnd:
'Generate Random row numbers within current Name Group
            nxtRnd = Int((numNamesleft - 2 + 1) * _
                         Rnd + 2)
'Loop through array, checking for Duplicates
             For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
              If MyRows(chkRnd) = nxtRnd Then GoTo getNewRnd
             Next
'Add element if Random number is unique
           MyRows(nxtRow) = nxtRnd
         Next

'Loop through Array, copying rows to Sheet2
    For copyrow = 1 To extRows
      dstRow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
            Sheets(Sheets.Count).Rows(MyRows(copyrow)).EntireRow.Copy _
            Destination:=Sheets(2).Cells(dstRow, 1)
    Next

'Delete new sheet
    Application.DisplayAlerts = False
       Sheets(Sheets.Count).Delete
    Application.DisplayAlerts = True

End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03



#1
July 6, 2016 at 21:57:57
re: Is there any easy way to perform this task within excel?
I guess that depends on your definition of easy. ;-)
This code will create an array of random row numbers.
The size of the array will be equal to 20% of the number of rows that contain data in Sheet1 Column A - assuming every row in the range contains data. In other words, it doesn't count the data in Column A, it just determines the last row that contains data.
It then loops through the array using the Random numbers as Row numbers to determine which rows to copy to Sheet2.
Please make sure you test this in a backup copy of your workbook as macro's can not be undone.
Option Explicit
Sub Random20()
Randomize 'Initialize Random number seed
Dim MyRows() As Integer ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer
'Determine Number of Rows in Sheet1 Column A
numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Get 20% of that number
percRows = numRows * 0.2
'Allocate elements in Array
ReDim MyRows(percRows)
'Create Random numbers and fill array
For nxtRow = 1 To percRows
getNew:
'Generate Random number
nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
If MyRows(chkRnd) = nxtRnd Then GoTo getNew
Next
'Add element if Random number is unique
MyRows(nxtRow) = nxtRnd
Next
'Loop through Array, copying rows to Sheet2
For copyRow = 1 To percRows
Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
Destination:=Sheets(2).Cells(copyRow, 1)
Next
End Sub


Report •

#2
July 7, 2016 at 11:55:01
ram12:

Please click on the last line of this post and read the instructions on how to use the pre tags when posting VBA code in this forum.

In addition, if you are going to copy and paste a solution that you find in the archives of this forum (or any forum for that matter) the polite thing to do is to give credit to the person whose solution you copied. It's one thing to do some research when trying to help answer a question and then offer what you find as a solution, but to simply copy and paste a post written by somebody else and essentially claim it as your own is just not right. The proper thing to do is to either give credit to person who wrote the original solution or to simply provide a link to the thread where the solution can be found.

Thanks for listening!

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#3
July 7, 2016 at 20:46:59
Thanks Ram12! The macro you provided copies 20% of the entire rows in Sheet1 to Sheet2 keying on the date in Column A. The hardest part of this puzzle for me is to also key on Column N which contains a Names for every item in Column A. There are duplicate Names. What I'm trying to do is to ensure that AT LEAST ONE of every Name is included in the data copied into Sheet2. I don't care if there are duplicate names I just need to make sure that at least EVERY unique name is included in the results. Is this possible?!

Report •

Related Solutions

#4
July 8, 2016 at 12:28:01
re: "I would like to pull a random sampling of the file numbers based on the following criteria:

- Pull at least 1 File Number for each Name (There are 100 unique Names)"

I'm sure you realize that once you add the requirement that at least one copy of each unique name be extracted, you no longer have a truly random sample of the original data set.

re: "SO, when it's all said and done, Sheet 2 should contain 500 rows of data containing 100 unique Names."

Actually, when all is said and done, Sheet 2 should contain 500 rows of data containing 100 unique names and 400 rows of other data.

The concept to create this sampling is very simple, however, the implementation is not so simple.

Conceptually, all we need to do is create the random list of 500 rows and then go back and make sure each unique value has been copied. Once a name is found that does not exist in the sampling, we simply copy it from the original data set and replace one the duplicates in the sampling.

The complexity comes in determining how to randomly add in those missing names and not just grab the first instance of the name in the data set. If we just grab the first instance, then you will always get the same row for that name each time that name is missing. I'm not that that any given name will always be missed, I saying that we need to find a way to randomize the selection of any missing name so that each time the code is run, a "random" selection of the missing name is copied.

That's going to take a little work. I'll see what I can do.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#5
July 8, 2016 at 13:55:32
Thanks DerbyDad03! I do realize that Sheet 2 will not be a truly random sample due to ensuring that no "Name" is left behind. This will be more of a random sampling per unique Name (Col N) totaling 20% of Sheet 1. I truly appreciate ANY help I can get on this as I'm at a total loss (and am a vba newbie).

Report •

#6
July 9, 2016 at 05:36:29
Your response prompts another question.

When you say that there are "100 uniques names” does that mean in a data set of 5000 entries there are 50 of each name or just that there is at least one entry for all 100 names?

In other words there might be e.g. 1 or 2 entries for Fred and 98 or 99 entries for Sue, as opposed to 50 for each.

50 of each would certainly make for an easier selection of a random yet evenly distributed extraction of each name. We would just take a random sample of 10 from each group of 50.

Can you describe your data set and desired output in a little more detail?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#7
July 9, 2016 at 11:03:40
The data will be pulled monthly. The total number of names and entries for each name will vary from month to month. There is a one "Name" to many "Entry ID" relationship. Ideally I would like to pull at least one entry for each unique name. Once every Name is accounted for, we can pull duplicate Names until the total number of entries reaches a specified percentage - 10% of the total entries should work. For names with more than 1 entry, I would like the selection to be as random as possible. In other words, not just pull the next entry in the report every time.

So, I just ran a data pull and the total number of entries = 935 (Col A)
The Unique number of Names (Col O) = 63
The desired output is to copy the entire row of data for each unique name to "Sheet2". Then add a random selection of the remaining entries until a total of 10% of all entries is reached. In this sample, that would be 33 more entries for a total of 93 rows of data.

Please let me know if you need anything further.

Thanks so much for all the help :-)


message edited by symaxf


Report •

#8
July 9, 2016 at 15:34:28
It would help if you were consistent with your requirements.

Original Post:

"I have a list of unique file numbers in Column A and a Name associated with each file number in Col N."

Response #3:

"key on Column N"

Response #5:

"per unique Name (Col N)"

Response #7:

"The Unique number of Names (Col O)"

Which is it? N or O?

Original Post:

"5000 rows of Data" , "100 unique Names"

Response # 7:

"total number of entries = 935 (Col A) ", "Unique number of Names (Col O) = 63"

Which is it? 5000 & 100 or 935 & 63 or variable numbers for both?

Original Post:

"10% of the total File Numbers in Col A"

Response # 5:

"totaling 20% of Sheet 1"

Response # 7:

"a total of 10% of all entries"

Which is it? 10% or 20%

I don't want to spend time writing code if the requirements are going to keep changing.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#9
July 9, 2016 at 21:24:50

"Which is it? N or O?"
O

"Which is it? 5000 & 100 or 935 & 63 or variable numbers for both?"
Variable number for both

"Which is it? 10% or 20%"
10%


Report •

#10
July 11, 2016 at 05:40:25
Just FYI...

I've written some code that seems to meet your requirements. I just need to test it some more and clean it up a bit. My schedule is packed today, but I hope to get to it later today.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#11
July 11, 2016 at 09:08:50
No problem! DerbyDad03, Thank you so much for all of your help!!!

Report •

#12
July 12, 2016 at 13:30:18
I'm in no hurry and will check back later this evening...

Report •

#13
July 12, 2016 at 19:10:56
I think I got it.

The following code should get you what you want.

Overview:

1 - The code first copies Sheet1 and adds it to the end of the workbook.
2 - It then sorts the new sheet by Name (Column O).
3 - It then loops through the sorted Names and counts how many occurrences of the first Name exists.
4 - Once it knows how many occurrences exist, it takes 10% of that number, rounding up so you always get at least 10%. e.g. 10% of 48 occurrences is 4.8. The code will use 5, so that you get the full 10%, not 4 which is less than 10%.
5 - The code will then randomly choose e.g. 5 rows within the 48 for that Name and build an array with those random row numbers.
6 - Once the array of random row numbers is built, the code will loop through the array, copying the e.g. 5 rows from the sorted sheet to Sheet2.
7 - After the random Rows for the first Name has been copied, the code then counts the number of occurrences of the next Name and repeats steps 4 - 6 over and over until a random 10% of each group of Names has been copied.
8 - Finally, the code deletes the Sheet that it added at the beginning.

Note 1: The data in Sheet2 will still be sorted by Name. If that is an issue, we should be able to fairly easily get it back into its original order.

Note 2: The code assumes that you have Columns Headings in Row 1. It actually starts counting Names in Row 2.

Suggestion 1: You should run this code in a back-up copy of your workbook in case things go terribly wrong.

Suggestion 2: If you are going to be using VBA, you might want to review this How-To.

http://www.computing.net/howtos/sho...

This tutorial contains a number of useful debugging techniques that can help you understand how the code works and possibly modify it as your requirements change.

Let me know what you think.



Sub Random10_EveryName()
Randomize 'Initialize Random number seed

   Application.ScreenUpdating = False

'Copy Sheet1 to new sheet
   Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)

'Clear old data in Sheet 2
  Sheets(2).Cells.ClearContents
  
'Determine Number of Rows in Sheet1 Column A
  numRows = Sheets(Sheets.Count).Cells(Rows.Count, _
              "A").End(xlUp).Row

'Sort new sheet by Column O
  Sheets(Sheets.Count).Cells.Sort _ 
   key1:=Sheets(Sheets.Count).Range("O1:O" & numRows), _
   order1:=xlAscending, Header:=xlYes

'Initialize numNames & startRow variable
  numNames = 1
  startRow = 2

'Loop through sorted names, count number of current Name
    For nameRows = startRow To numRows
      If Sheets(Sheets.Count).Cells(nameRows, "O") = _
         Sheets(Sheets.Count).Cells(nameRows + 1, "O") Then
           numNames = numNames + 1
      Else:

''Extract Random 10% of current Name, Round Up to next integer
'Set last row of current Name group
        endRow = startRow + numNames - 1
'Get 10% of number of current name
        percRows = _
            WorksheetFunction.RoundUp(numNames * 0.1, 0)
        
'Allocate elements in Array
        ReDim MyRows(percRows)
'Create Random numbers and fill array
         For nxtRow = 1 To percRows
getNewRnd:
'Generate Random row numbers within current Name Group
           nxtRnd = Int((endRow - startRow + 1) * _
                         Rnd + startRow)
'Loop through array, checking for Duplicates
            For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
              If MyRows(chkRnd) = nxtRnd Then GoTo getNewRnd
            Next
'Add element if Random number is unique
           MyRows(nxtRow) = nxtRnd
         Next

'Loop through Array, copying rows to Sheet2
        For copyRow = 1 To percRows
         dstRow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
           Sheets(Sheets.Count).Rows(MyRows(copyRow)).EntireRow.Copy _
             Destination:=Sheets(2).Cells(dstRow, 1)
        Next
    
'Set Start Row for next Name Group, reset numNames variable
        startRow = endRow + 1
        numNames = 1
    
      End If
    Next

'Delete new sheet
    Application.DisplayAlerts = False
       Sheets(Sheets.Count).Delete
    Application.DisplayAlerts = True

End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#14
July 12, 2016 at 22:44:51
First of all, I have no words to express how grateful I am for this. Not only does the code look like art, you have explained each line and gave a fantastic overview. I truly appreciate your efforts and learned a lot in the process.

The results weren't exactly what I was looking for but that may be my fault. My test data contains 977 unique entries (Col A). Col 0 contains 64 unique names (914 duplicate names). I ran your code which returned 132 entries, instead of the 97 I was expecting (10% of 977).

Your code gave me 10% of each ENTRY for every NAME, which adds up to 132.
What I need is to ensure that I get at least 1 entry for each unique name (Col O), which your code provided, but I need the total to be 10% of the total number of ENTRIES from Col A ( 97 for this report - 64 unique names + 33 duplicate random names).


Report •

#15
July 13, 2016 at 10:02:37
Unless I am missing something, there is an issue with your requirements.

If the number of unique names is greater than 10% of the total entries, then your requirements can not be met.

For example, if there were 120 unique entries in Column A and 20 unique names, your requirements state that your output should be:

- At least one row for each of the 20 unique names = 20 rows
- 120 * 10% = 12 rows

I'm sure you can see the problem with that output.

Will 10% of the total entries always be higher than the number of unique names? If not, how do you want to deal with that situation?

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#16
July 13, 2016 at 12:44:09
"Will 10% of the total entries always be higher than the number of unique names?"
The short answer is I don't know.

In all of the reports I've run, so far the total number of entries was ALWAYS 10% higher. I would say that whenever the total entries is LESS THAN 10% of the unique names to pull ONLY a SINGLE ENTRY for EACH unique name, thus, ignoring the 10%.

So using your example, 20 unique names and only 120 entries - pull a single entry for each name. Is that doable?

message edited by symaxf


Report •

#17
July 13, 2016 at 12:53:30
✔ Best Answer
This code will pull at least 1 copy of each unique name and add any extra rows if required. The code will warn the user if the number of unique Names exceeds 10% of the total entries.

Overview:

1 - The code first copies Sheet1 and adds it to the end of the workbook.
2 - It then sorts the new sheet by Name (Column O).
3 - It then determine which rows contain the first and last entry of the first Name.
4 - Once it knows the starting and ending rows, the code generates a random number within that range and copies that single row to Sheet2.
5 - Once the row has been copied, the code deletes the Name in Column 0, leaving an empty cell. This ensures that any row that has already been randomly selected will not be selected again, as explained in Step 7.
6 - Steps 3-5 are repeated until one occurrence of each unique name has been copied and deleted.
7 - The code then resorts Column O to move all of the blank cells to bottom of the list. This allows the code to work with the list of remaining Names, i.e. Names that have not yet been randomly selected.
8 - The code then determines 10% of the total entries in Sheet1 as well as the number of unique Names that have already been copied to Sheet2. Using these values, the code determines how many "extra" rows it needs to copy to reach the required 10%.
9 - The code then builds an array of "extra" random row numbers from the remaining Names in Column O of the new sheet.
10 - Once the array of random row numbers is built, the loops through the array, copying the rows from the new sheet to Sheet2.
11 - Finally, the code deletes the new Sheet.

Sub Random10_EveryName()
Randomize 'Initialize Random number seed

   Application.ScreenUpdating = False

'Copy Sheet1 to new sheet
   Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)

'Clear old data in Sheet 2
  Sheets(2).Cells.ClearContents
  
'Determine Number of Rows in Sheet1 Column A
  numRows = Sheets(Sheets.Count).Cells(Rows.Count, _
              "A").End(xlUp).Row
              
'Sort new sheet by Column O
  Sheets(Sheets.Count).Cells.Sort _
   key1:=Sheets(Sheets.Count).Range("O1:O" & numRows), _
   order1:=xlAscending, Header:=xlYes

'Initialize numNames & startRow variable
  numNames = 1
  startRow = 2

'Loop through sorted names, count number of current Name
    For nameRows = startRow To numRows
      If Sheets(Sheets.Count).Cells(nameRows, "O") = _
         Sheets(Sheets.Count).Cells(nameRows + 1, "O") Then
           numNames = numNames + 1
      Else:
        endRow = startRow + numNames - 1

'Generate Random row number within current Name Group
           nxtRnd = Int((endRow - startRow + 1) * _
                         Rnd + startRow)

'Copy row to Sheet2, Delete copied Name
         dstRow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
           Sheets(Sheets.Count).Rows(nxtRnd).EntireRow.Copy _
             Destination:=Sheets(2).Cells(dstRow, 1)
         Sheets(Sheets.Count).Cells(nxtRnd, "O").ClearContents
        
'Set Start Row for next Name Group, reset numNames variable
        startRow = endRow + 1
        numNames = 1
      End If
    Next

'Sort new sheet by Column O
    Sheets(Sheets.Count).Cells.Sort _
      key1:=Sheets(Sheets.Count).Range("O1:O" & numRows), _
      order1:=xlAscending, Header:=xlYes
   
'Determine Number of Remaining Names in new sheet Column O
    numNamesleft = Sheets(Sheets.Count).Cells(Rows.Count, _
              "O").End(xlUp).Row - 1
              
'Determine 10% of total entries from Sheet1
    percRows = _
        WorksheetFunction.RoundUp((numRows - 1) * 0.1, 0)
        
'Determine how many extra rows are needed to reach 10% of total
    unqNames = Sheets(2).Cells(Rows.Count, _
              "O").End(xlUp).Row - 1
    extRows = percRows - unqNames
    
'Warn user if number of Unique Names exceeds 10% of Total Entires
      If extRows < 0 Then
        MsgBox "Number of Unique Names Exceeds 10% of Total Entries"
'Delete new sheet
          Application.DisplayAlerts = False
            Sheets(Sheets.Count).Delete
          Application.DisplayAlerts = True
        Exit Sub
      End If
      
'Extract Random entries from remaining names to reach 10%
'
'Allocate elements in Array
        ReDim MyRows(extRows)
'Create Random numbers and fill array
         For nxtRow = 1 To extRows
getNewRnd:
'Generate Random row numbers within current Name Group
            nxtRnd = Int((numNamesleft - 2 + 1) * _
                         Rnd + 2)
'Loop through array, checking for Duplicates
             For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
              If MyRows(chkRnd) = nxtRnd Then GoTo getNewRnd
             Next
'Add element if Random number is unique
           MyRows(nxtRow) = nxtRnd
         Next

'Loop through Array, copying rows to Sheet2
    For copyrow = 1 To extRows
      dstRow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
            Sheets(Sheets.Count).Rows(MyRows(copyrow)).EntireRow.Copy _
            Destination:=Sheets(2).Cells(dstRow, 1)
    Next

'Delete new sheet
    Application.DisplayAlerts = False
       Sheets(Sheets.Count).Delete
    Application.DisplayAlerts = True

End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03


Report •

#18
July 13, 2016 at 17:11:25
DerbyDad03, My friend, I've run your code on multiple files and tried to break it but this code is absolutely unbreakable and 100%flawless! You Sir, are the absolute best! Thanks for all of your help and for the VBA lessons! Take care!

Report •

#19
July 13, 2016 at 18:39:46
I'm glad it works for you.

It's not the most elegant code, it's more of brute force method, but it seems to get the job down.

I assume that if I had used multiple arrays within VBA I might have been able to avoid creating a new sheet and sorting the data (twice), etc. In other words, not using Excel, just VBA. That, however, would have been a lot more work and I just don't have the time for that right now.

Let me know if you run into any issues.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •


Ask Question