Macro to Group Rows Throughout Excel Document - excel

I have looked around and I feel like I am going crazy for not understanding how to do this, or what to do. It seems simple and yet I cannot figure out the best method.
I have an excel document that has 8 rows of data and that is supported by individual data from individuals that is 16 rows long. In total, there are 600 individuals in the dataset.
I was trying to locate a macro that would simply allow me to group every 16 rows in my excel sheet together. Whatever I have tried though, has not worked.
I am using Microsoft Excel 20116 for mac.

Range("1:16").Select
Selection.Rows.Group
Range("17:32").Select
Selection.Rows.Group
Repeat!
If there is a predictable data pattern (i.e. always exactly 16 rows) you might wish to put this inside a loop, where Range.Select is offset a further 16 rows each time.
For example:
i = 1
j = 16
While i < "YOUR UPPER LIMIT"
Range(i & ":" & j).Select
Selection.Rows.Group
i = i+16
j = j+16
Next
Note that if you group contiguous rows without a break, your groupings will automatically combine. You will need to play around with the line Range(i & ":" & j).Select to either use i+1 or j-1 depending on what you want as your display row on the grouping.

Related

Possible faster VBA lookup with wildcards?

I need to perform a quite a lot of lookups with wildcards on the worksheet using a macro (mainly lookup for value & returning the value from another column though with proper adjustment it can be also just looking for a value with wildcard, and some lookups only as checks if the value exists in the dataset). My data can't be sorted and all the lookups are within a loop A or loops within loop A; wildcards are included mostly for condition "string begins with...". I often have to find a value in one row and find corresponding value in row N rows below or above.
I have a working code, but I wonder if it can be done faster. #response to comment about posting it on Code Review (sorry, I cannot comment yet :)) - preparation the whole code to posting would take a bit too much time for me, confidentiality etc, so I prefer to treat it as a general question to be worked on this example.
Example data (I can add more columns, if I need any helper column):
Example Data picture at Imgur
Assume 100 000 rows (max xPagesCount = 1000, typically around 400; all values for certain xPage is in one block). Due to a lot of possible rows with additional data I can't simply find one value and add numbers to the found row to find the other values by their position.
Example lookups to perform while looping through consecutive xPages (so, for each given xPage):
value in row just below row with "RESTRICTIONS:" text
find name (which is always given with height (column C) = 35)
find RSW number (which can be in several rows depending on page content, but always below name)
find all rows starting with the same four digits as RSW, in two formats: DDDD.LLL.DD and DDDD.DDDDD.DD (L letter, D digit) (I use internal loop here)
check if there is a text "MASTER" (or "MASTER " etc.)
find all values between values "DOCUMENTS:" and "OPTIONS:", which quantity can be from 1 to 50 (I use internal loop here)
I was wondering, what is the fastest way to do such lookups?
What I tried:
using a dictionary on all dataset (keys in column A or C with, values
col.D) but as dictionary can't work on wildcards, I had to add ifs
for not finding a key to perform additional Application.Match
lookup... and then realized it mostly worked on these Match lookups
and not sure I even need a dictionary. I also have duplicate values
within a page and dictionary was getting only first value, regardless
their position (for example, several attachments could have value 1).
The main use remained dict.exists("MASTER") but when I removed
dictionary and changed it to IsError(Application.Match(...)) the code
worked slightly faster.
Application.Match in whole range, typical example: Application.Match(xPage & "4???.*", sh.Range("A1:A" & LastRow), 0)
in few places I use If xValue Like "????.???.??" Then construction
I have dictionary lookups with ifs redirecting to Application.Match:
xValue = dict(xPage & "ATH.416")
If dict(xPage & "ATH.416") = "" Then xValue = Application.Match("ATH.*", Sheets(1).Range("D:D"), 0)
What I consider, but not sure it's worth the effort:
altering the code that at the beginning of the iteration I find the first and the last row for xPage, and then each later check is performed in this range
xStartPage = sh.Range("D" & Application.Match(xPage, sh.Range("A1:A" & LastRow), 0))
'or, I guess better:
xStartPage = xEndPage + 1
If xPage = xPagesCount Then
xEndPage = LastRow
Else
xEndPage = sh.Range("D" & Application.Match(xPage + 1, sh.Range("A1:A" & LastRow), 0) - 1)
End If
xValue = sh.Range("D" & Application.Match("4???.*", sh.Range("D" & xStartPage & ":D" & xEndPage), 0)).Value

Issue with nested for loops in VBA

I'm working on a project in Excel that helps a club here on campus allocate money to various other clubs. Anyways, I'm attempting to implement a macro-assigned button to allow the club to generate a new sheet that summarizes the event name, and the funding granted to the event.
The issue I'm currently stuck on is assigning 12 rows of data on this new sheet, for each club listed in the 'Summary' tab. I have the formula so that it cycles through the summary tab and inputs the club name down, but it continually inputs these names into cells A1-A12, rather than adding 12 new rows for the next club.
If my wording is confusing to follow; I want club 1's data to be in cells A1-12, club 2 in A13-24, etc.
I'm relying on nested for loops to try and cycle through and create these rows. Here's the part that's giving me trouble:
For k = 0 To 200 Step 12
'J is used to get names off the 'summary' tab
For j = 8 To Sheets.Count
'I is used to select cells 'a1' to 'a12'
For i = 1 To 12
Range("A" & (k + i)).Select
ActiveCell.Formula = ("=Summary!$A$" & j)
Next i
Next j
Next k
I'm certain my problem lies in the fact that j is advanced further before k, meaning it will continue to see k as 0 and input the new club's name in a1-a12, rather than stepping it up 12 BEFORE j is advanced. Whenever I try to insert next k above next j, I'm given an error.
This nested for loop is messy and is starting to make my brain hurt- but I can't seem to figure out a better way to tell Excel to skip 12 rows at a time. If anyone has any input or ideas on how to execute this macro in an easier way- let me know :-)
Try this code. There is no need to select cell before writing formula in it...
For j = 8 To Sheets.Count
For i = 1 To 12
Range("A" & ((j - 8) * 12 + i)).Formula = ("=Summary!$A$" & j)
Next i
Next j

Alphanumerical sorting - paste error - large amount of data

I've devellopped a quick little code to help me sort a large amount of data on an excel tool, it works perfectly except for one tiny detail ruining all of my work so far.
My table is 500+ columns wide and my algorithm would like to copy and paste two rows at a time (I use fused cells and do not wish to use an alternative to that).
My algorithm then tries to do :
Rows(i & ":" & i + 1).Cut
Rows(j & ":" & j + 1).Select
Selection.Insert shift:=xlDown
i and j being the row index (I try to put row j and j+1 just below row i and i+1
Which tells me that excel cannot do with the current ressources.
I tried to reduce the amount of cells with something like
range(cells(i,bc),cells(i+1,ec)).cut
range(cells(j,bc),cells(j+1,ec)).select
Selection.Insert shift:=xlDown
bc being the first column of my selection and ec the last
But still I have the same problem (selection is between 500 and 510 colums so around 1k cells)
So here is the question :
Is there a way to bypass that error and force the cut/paste? (I would like to avoid changing x columns at a time, slowing a process already quite slow)
Or a way to change the index of the row or something alike that I do not know about ?
Thank you for your time and future answers.
PEagle
This is not the answer, just too long to put as a comment.
I just ran the code below (with 700 columns of data per row), and it Cut >> Paste just fine without errors.
Option Explicit
Sub CopyFullTwoRows()
Dim i As Long, j As Long
' just for simulation
i = 2
j = 10
Rows(i & ":" & i + 1).Cut
Rows(j & ":" & j + 1).Insert Shift:=xlDown
End Sub
Sorry i am not yet at comment privilegies, so here is the answer to your comments/answers:
My file is about 6300KB.
For other programs, generaly just the outlook and firefox but computers at work are not very powerful.
Regarding the flatening of my merged cells and then sorting, the problem is then that I need to do sorting but only on even lines.
As it is a file from work I cannot send it on the internet, but to give you an idea, I have 2 lines working together, columns B to F are merged (B8+B9, B10+B11 etc, then C8+C9 etc.) and then I have two rows of data for each of these lines.
Unmerging would cause blank cells to pop and then sorting would mess the whole table.
I am sorry, my question is now obsolete.
I reorked the file, noticing that the file, for a reason I do not know, included all lines until the end of the sheet (1+ million). I have removed the unnecessary lines (recreated the file) and it now works fine.
sorry for your time loss, thank you for helping me.
See you soon.

How can I add a 1 to the most recent, repeated row in Excel?

I have a dataset with 60+ thousand rows in excel and about 20 columns. The "ID column" sometimes repeats itself and I want to add a column that will return 1 only in the row that is the most recent only IF it repeats itself.
Here is the example. I have…
ID DATE ColumnX
AS1 Jan-2013 DATA
AS2 Feb-2013 DATA
AS3 Jan-2013 DATA
AS4 Dec-2013 DATA
AS2 Dec-2013 DATA
I want…
ID DATE ColumnX New Column
AS1 Jan-2013 DATA 1
AS2 Feb-2013 DATA 0
AS3 Jan-2013 DATA 1
AS4 Dec-2013 DATA 1
AS2 Dec-2013 DATA 1
I've been trying with a combination of sort and nested if's, but it depends on my data being always in the same order (so that it looks up the ID in the previous row).
Bonus points: consider my dataset if fairly large for excel, so the most efficient code that won't eat up processor would be appreciated!
An approach you could use is to point MSQuery at your table and use SQL to apply the business rules. On the positive side, this runs very quickly (a couple seconds in my tests against 64k rows). A huge minus is the query engine does not seem to support Excel tables exceeding 64k rows, but there might be ways to work around this. Regardless, I offer the solution in case it gives you some ideas.
To set up first give your data set a named range. I called it MYTABLE. Save. Next select a cell to the right of your table in row 1, and click through Data | From other sources | from Microsoft Query. Choose Excel Files* | OK, browse for your file. The Query Wiz should open, showing MYTABLE available, add all the columns. Click Cancel (really), and click Yes, you want to continue editing.
The MSQuery interface should open, click the SQL button and replace the code with the following. You will need to edit some specifics, such as the file path. (Also, note I used different column names. This was sheer paranoia on my part. The Jet engine is very finicky and I wanted to rule out conflicts with reserved words as I built this.)
SELECT
MYTABLE.ID_X,
MYTABLE.DATE_X,
MYTABLE.COLUMN_X,
IIF(MAXDATES.ID_x IS NULL,0,1) * IIF(DUPTABLE.ID_X IS NULL,0,1) AS NEW_DATA
FROM ((`C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE
LEFT OUTER JOIN (
SELECT MYTABLE1.ID_X, MAX(MYTABLE1.DATE_X) AS MAXDATE
FROM `C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE1
GROUP BY MYTABLE1.ID_X
) AS MAXDATES
ON MYTABLE.ID_X = MAXDATES.ID_X
AND MYTABLE.DATE_X = MAXDATES.MAXDATE)
LEFT OUTER JOIN (
SELECT MYTABLE2.ID_X
FROM `C:\Users\andy3h\Desktop\SOTEST1.xlsx`.MYTABLE MYTABLE2
GROUP BY MYTABLE2.ID_X
HAVING COUNT(1) > 1
) AS DUPTABLE
ON MYTABLE.ID_X = DUPTABLE.ID_X)
With the code in place MSQuery will complain the query can't be represented graphically. It's OK. The query will execute -- it might take longer than expected to run at this stage. I'm not sure why, but it should run much faster on subsequent refreshes. Once results return, File | Return data to Excel. Accept the defaults on the Import Data dialog.
That's the technique. To refresh the query against new data simply Data | Refresh. If you need to tweak the query you can get back to it though Excel via Data | Connections | Properties | Definition tab.
The code I provided returns your original data plus the NEW_DATA column, which has value 1 if the ID is duplicated and the date is the maximum date for that ID, otherwise 0. This code will not sort out ties if an ID's maximum date is on several rows. All such rows will be tagged 1.
Edit: The code is easily modified to ignore the duplication logic and show most recent row for all IDs. Simply change the last bit of the SELECT clause to read
IIF(MAXDATES.ID_x IS NULL,0,1) AS NEW_DATA
In that case, you could also remove the final LEFT JOIN with alias DUPTABLE.
Sort by ID, then by DATE (ascending). Define entries in new column to be 1 if previous row has the same ID and next row has a different ID or is empty (for last row), 0 otherwise.
It could be done in VBA. I'd be interested to know if this is possible just using formulas, I had to do something similar once before.
Sub Macro1()
Dim rowCount As Long
Sheets("Sheet1").Activate
rowCount = Cells(Rows.Count, 1).End(xlUp).Row
Columns("A:D").Select
Selection.AutoFilter
Range("D2:D" & rowCount).Select
Selection.ClearContents
Columns("A:D").Select
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("B1:B" & rowCount), SortOn:=xlSortOnValues
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
("A1:A" & rowCount), SortOn:=xlSortOnValues
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.Apply
Dim counter As Integer
For counter = 2 To rowCount
Cells(counter, 4) = 1
If Cells(counter, 1) = Cells(counter + 1, 1) Then Cells(counter, 4) = 0
Next counter
End Sub
So you activate the sheet and get the count of rows.
Then select and autofilter the results, and clear out Column D which has the 0s or 1s. Then filter on the values mbroshi suggested that you say you're already using. Then execute a loop for each record, changing the value to 1, but then back to 0 if the value ahead of it has the same ID.
Depending on your processor I dont think this would take more than a minute or two to run. If you do find something using formulas I would be interested to see it!

Moving multiple sets columns into a single set of columns

I have a spreadsheet with columns of data in A-B-C-D-E for a single Person's Data.
Then, the same headers are repeated in columns F-G-H-i-J, for a 2nd Person's Data
Then, the same headers are repeated again in the next 5 columns, and this goes on for 25 sets of columns (so I have data for 25 people going across).
There are about 50 rows down of this data.
The data headers are as follows:
A-Name
B-DOB
C-Level
D-Acct#
E-Tshirt Size
F-Name
G-DOB
H-Level
I-Acct#
E-Tshirt Size
Repeating for 25 sets
I would like to move all of the data so that is is in only columns A-B-C-D-E.
I would like ALL of the Names to appear in Column A, All of the DOBs to appear in Column B, etc.
I have seen something similar to this posted here but I don't understand how to re-write the code to fit my specific situation.
I have struggled with this problem for 3 years and copy/pasted everything by hand which takes hours. I would really appreciated any information on how to automate this.
Thank you!
it needs fiddling with but here's a start:
Sub CopySomeCells()
With Excel.ThisWorkbook.Sheets("myExample")
lastcellincolumnA = .Cells(.Rows.Count, 1).End(Excel.xlUp).Row
lastcellincolumnL = .Cells(.Rows.Count, 12).End(Excel.xlUp).Row
.Range("G1:L" & lastcellincolumnL).Copy
.Range("A" & (lastcellincolumnA + 1)).PasteSpecial Excel.xlValues
End With
End Sub

Resources