VBA script for grouping columns - vba

I've come across Stackoverflow many times when I've been looking for excel VBA scripting answers, but I've come up to a wall with my searching for an answer to my problem.
I have data which I need to sort, but it needs to be row grouped first, otherwise the sorting takes away the conformity of the info.
I want to group using info on just 1 column, and have found VBA scripts which do what I want except that they group 1 row to many. (if that makes sense)
i have info a little like
a b c d
Revise blank cell info info
blank cell blank cell info info
blank cell blank cell blank cell blank cell
Revise blank cell info info
blank cell blank cell info blank cell
Revise blank cell info info
etc etc
I want to group the top 3 rows, then the next 2.
but the only VBA script I found looks down the column for the word 'revise' but then groups the cells above the word revise, not below
I hope all that makes sense
thanks for any help
BTW, I dont really have any knowledge of programming, other than what I've gained through running some macros on other projects. Hopefully I wont need telling like a 5 YO, but may need some explanations of any code specific terms
I got this VBA script which works as I described
Option Explicit
Sub Macro2()
Dim rData, rCel As Range
Set rData = Range("a1", Range("a" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
With rData
On Error Resume Next
.Rows.Ungroup
.Rows.EntireRow.Hidden = False
On Error Goto 0
End With
For Each rCel In rData
If rCel = "END" Then Exit For
If rCel <> "Revise" Then
Rows(rCel.Row).Group
rCel.EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True
End Sub

Here's a quick and dirty non-VBA solution, as you say you are not overly familiar with VBA.
Add a column to the right of your data, which will hold a new index that tracks each time 'Revise' is listed in column A. Starting in A2 and copied down, this will look as follows [you may need to hardcode the first entry as 1]:
=if(A2="Revise",A1+1,A1)
This will create a column which increases by 1 each time there is a new "Revise". Then just select your entire data block, right-click, and Sort by your new index column.

Related

Copy Range Excluding Blank Cells - Paste to Another Sheet

Ok, back again!
I have tried to search throught this and other forums to find a similar solution, but everything Ive found is either just different enough that I cant figure out the application to my problem, or super complex, and I cant translate it! So Im hoping someone can help me here. Thanks in advance!!
Here is the scenario. I have a database that Im needing to add data to. Quote Number, PO Number,SubSystem Part Name, Vendor, Material, Price, Qty. Etc.
Long story short, and without getting into the context of why I did it this way (mostly because I think I would botch the explaination and be more confusing than helpful!) ... I have essentially 3 tables right next to each other.
Table 1 is columns H and I. These all have a formula similar to =if(isblank(J4),"",$I$1) Where I1 is the PO Number (which will remain the same for this set of entries.)
Table 2 is a pivot table in columns J through M. Using a slicer the user can select what sub systems they need for this PO. The pivot table will repopulate with the appropriate part numbers and unique information contained in another table.
Table 3 is a regular table in columns N through R. These columns have some formulas like above that pull from a single cell (for entering the date), some pull information from another table based on information in column J via a VLOOKUP, and some information is entered manually.
That might be too much information, but better to have it and not need it eh?
So heres the goal. With a VBA macro, I want to copy the data and paste it onto another sheet, at the bottom of a database. The trick is, because that whole setup above runs based on information coming from a pivot table, the list changes length constantly. It will never be longer than a certain length (still TBD) but will almost always be shorter. I can copy the whole thing, and have it paste to another sheet below the last entry... but it pastes below the last empty cell in the database sheet. What I mean is this:
The longest the table could be would be range H4:R38 for example. So I copy that, paste it to Sheet2 starting at cell A2. Upon further inspection, we see that there is only actual data in the range H4:R11. However, when we pasted it to Sheet2 it pasted the whole range H4:R38. When I run the macro again, instead of the new data set being pasted to row A10 (the row after where the data should have ended), it pastes to something like row 36... because its pasting below all the blank cells.
I have no idea what to do or where to start. Any help would be greatly appreciated! Thanks so much!
Code I've Tried:
Dim fabricationrange As Range
Dim destination As Range
Dim LastBBUFabDatabaseRow As Long
Worksheets("Sub Systems").Range("h4:r38").Copy
With ThisWorkbook.Sheets("BBU Fab. Database")
Worksheets("bbu fab. database").Range("z" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Range("b" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
lastbbufabdatabserow = .Cells(.Rows.Count, 2).End(xlUp).Row = 1
Set destination = .Cells(LastBBUFabDatabaseRow, 2)
destination.Value = PasteSpecial.Values
End With
Untested but here's a brute-force approach to locating the first empty row:
set rngDest = ThisWorkbook.Sheets("BBU Fab. Database").rows(2) '<< start here
do while application.counta(rngDest) > 0
set rngDest = rngDest.offset(1, 0) 'next row
loop
Worksheets("Sub Systems").Range("H4:R38").Copy
rngDest.cells(1).PasteSpecial xlPasteValuesAndNumberFormats '<< paste to col A

Embedded "IF" formula breaks occasionally, VBA alternative?

I have a very large embedded IF formula that appears to occasionally break for no reason. Opening and closing the page a few times eventually gets it working again. I am wondering if there is a VBA alternative for it. Here is the IF formula I am running.
=IF(ISNUMBER(SEARCH("76210",E125)),"_012_00762_10",IF(ISNUMBER(SEARCH("76220",E125)),"_012_00762_20",IF(ISNUMBER(SEARCH("76900",E125)),"_012_00769_00",IF(ISNUMBER(SEARCH("76901",E125)),"_012_00769_01",IF(ISNUMBER(SEARCH("85702",E125)),"_012_00857_02",IF(ISNUMBER(SEARCH("85710",E125)),"_012_00857_10",IF(ISNUMBER(SEARCH("100800",E125)),"_012_01008_00",IF(ISNUMBER(SEARCH("100900",E125)),"_012_01009_00",IF(ISNUMBER(SEARCH("123100",E125)),"_012_01231_00",IF(ISNUMBER(SEARCH("124600",E125)),"_012_01246_00",IF(ISNUMBER(SEARCH("124601",E125)),"_012_01246_01",IF(ISNUMBER(SEARCH("124640",E125)),"_012_01246_40",IF(ISNUMBER(SEARCH("124641",E125)),"_012_01246_41",IF(ISNUMBER(SEARCH("142301",E125)),"_012_01423_01",IF(ISNUMBER(SEARCH("158801",E125)),"_012_01588_01",IF(ISNUMBER(SEARCH("158900",E125)),"_012_01589_00",IF(ISNUMBER(SEARCH("159203",E125)),"_012_01592_03",IF(ISNUMBER(SEARCH("159303",E125)),"_012_01593_03",IF(ISNUMBER(SEARCH("159401",E125)),"_012_01594_01",IF(ISNUMBER(SEARCH("159410",E125)),"_012_01594_10",IF(ISNUMBER(SEARCH("159420",E125)),"_012_01594_20",IF(ISNUMBER(SEARCH("159501",E125)),"_012_01595_01",IF(ISNUMBER(SEARCH("169000",E125)),"_012_01690_00",IF(ISNUMBER(SEARCH("186900",E125)),"_012_01869_00",IF(ISNUMBER(SEARCH("213200",E125)),"_012_02132_00",IF(ISNUMBER(SEARCH("213300",E125)),"_012_02133_00",IF(ISNUMBER(SEARCH("215400",E125)),"_012_02154_00",IF(ISNUMBER(SEARCH("220100",E125)),"_012_02201_00",IF(ISNUMBER(SEARCH("223800",E125)),"_012_02238_00",IF(ISNUMBER(SEARCH("225600",E125)),"_012_02256_00",IF(ISNUMBER(SEARCH("230700",E125)),"_012_02307_00",IF(ISNUMBER(SEARCH("230701",E125)),"_012_02307_01",IF(ISNUMBER(SEARCH("231800",E125)),"_012_02318_00",IF(ISNUMBER(SEARCH("235000",E125)),"_012_02350_00",IF(ISNUMBER(SEARCH("235020",E125)),"_012_02350_20",IF(ISNUMBER(SEARCH("242000",E125)),"_012_02420_00",IF(ISNUMBER(SEARCH("246400",E125)),"_012_02464_00",IF(ISNUMBER(SEARCH("292900",E125)),"_012_02929_00",""))))))))))))))))))))))))))))))))))))))
Basically it is built so a serial number is scanned and it populates a cell for the users who use this sheet with its results from the search. I am already running one macro in this sheet as well. Here is that...
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Range("A2:A500, J2:J500"), Target) ' define range of interest
If Not rng Is Nothing Then ' check it's not "nothing"
If WorksheetFunction.CountA(rng) = rng.Count Then 'check for all of its cells being not empty
On Error GoTo safe_exit 'add error control
Application.EnableEvents = False 'don't do anything until you know something has to be done
rng.Offset(, 1).Value = Date 'write Date next to all relevant changed cells
End If
End If
safe_exit:
Application.EnableEvents = True
End Sub
Maybe there is a better way to build this search using a formula that isn't using embedded IF statements, but i couldn't think of another way to do it. Thanks in advance.
This may be what you're looking for:
=IF(ISNA(MATCH(1,IF(ISERR(SEARCH($A$5:$A$42,$E$125)),0,1),0)),"",INDEX($B$5:$B$42,MATCH(1,IF(ISERR(SEARCH($A$5:$A$42,$E$125)),0,1),0)))
entered as an array formula (CTRL-SHIFT-ENTER).
Here $A$5:$A$42 contains 76210, 76220, ... , 292900 (entered as text, not numbers); and $B$5:$B$42 contains _012_00762_10, _012_00762_20, ... , _012_02929_00.
Hope that helps.
Any time you have to go more than 2 deep on an IF you may want to rethink the usage.
What you can do is build a table from your values. Then reference that table as part of your lookup. Assuming your list of value is in range D8:E45 you could use the formula =VLOOKUP(E125,$D$8:$E$45,2).
The beginning of your table would look like what's seen below. The input result cell is referencing your input value and pulling the match of the second column.
To get your table you can take your source formula and replace (Find and Replace - Ctrl+H) some characters with unique delimiting characters. Then use Text To Columns Alt+D+E and delimit and Copy>Paste special>Transpose to quickly have it close to the format you need.

sumifs to loop all sheets

I have been searching different forums and cant seem to find my answer.
I have rather basic VBA knowledge and build most of my code from bits online!
Regardless of cell references as I would be able to work these out at a later date.
Please can you let me how I would make a sumifs formula reference across multiple sheets.
This is being build into a template and there would be a different number of sheets with different names each time it is run so I would be not be able to reference the sheets.
sorry thats a bit vague
thanks in advanced
Thanks, so for anyone else who needs this, this is how it was done in full
my original formula was
"=SUMPRODUCT(SUMIF(INDIRECT(" '"&Invoices&"'!"&"A2006:A3005"),A3,INDIRECT("'"&Invoices&"'!"&"B2006:B3005")))"
this worked when putting straight into a cell but as you can see, when adding it to VBA it reads it as a comment. To fix this, every time you use a " you need to add extra " as shown bellow (apart form before the" = at the start and after the )" at the end of the formula)
*****'list all the sheet names in cell AI1 of the sheet summary*****
For i = 1 To Sheets.Count
Sheets("Summary").Range("AI1")(i, 1).Value = Sheets(i).Name
Next i
***'clear the first 3 entries in AI as i didnt need the first three sheet names***
Sheets("Summary").Select
Sheets("Summary").Range("AI1:AI3").Clear
***'select the first sheet name, which is in AI4 as we cleard the first 3 to the last used cell, e.g Ctrl.Shift.down***
Sheets("Summary").Activate
Sheets("summary").Range(ActiveSheet.Range("AI4"), ActiveSheet.Range("AI4").End(xlDown)).Select
***' Name the range invoices***
Selection.Name = "Invoices"
' ***Formula to do a sumIf looping all the shets in the named range Invoices***
Sheets("summary").Range("B3").Formula = "=SUMPRODUCT(SUMIF(INDIRECT(""'""&Invoices&""'!$A$2006:$A$3005""),$A3,INDIRECT(""'""&Invoices&""'!B$2006:B$3005"")))"

VBA - Copy from Closed File paste to next available row on Summary Sheet

This is my first post. Forgive me if i am doing something wrong here. I will be glad to correct any mistakes. I have found the web site to be very valuable as i am a baby in the field of vba. Please have patience with me.
I am a super rookie in VBA. I am learning as i go but have spent a lot of time on this. I find bits and pieces of information on the web but have trouble in putting them all together. I have learned how to make a vba macro that i can select a file and then run other macros.
I am using Excel 2013.
I complete a time sheet every week(sometimes more at end of month) of the hours i work and the projects i work on. I also include on that sheet when i am out and a code for the reason. I would like to copy three sections to a summary sheet.
Cell D1. This cell always has the date beside it. I would like to copy this to the cell in my first row.
Cells F3-L3 are cells where a code is put. I would like to copy this to the second cell in my first row.
The next range of cells aret the last cells with data in columns F-L. These vary as we have different numbers of rows for work orders each time but are always in columns F-L. I would like to copy this to a second row below the corresponding cells in the first.
For the next file I would like to copy to the next available row in summary.
I would like to copy this data so i can figure vacation days, sick days, etc.
I know i'm asking alot but would be extremely grateful for any help.
i'm giving you this as Example, you will still need to modify...
Option Explicit 'forces Programmer to declare variables
Sub Button_To_Copy () 'link this to a button or other action that launchs the sub
Dim Range_to_Copy as Range
Dim Range_Destination as Range
Dim Sheet_Data as worksheet 'sheet from where we pull the data
Dim Sheet_Destination as Worksheet' Summary Sheet
set Sheet_Data = Thisworkbook.Sheets("Sheet1") 'you might have to rename the sheetname accordingly to its name.
set Sheet_Destination = Thisworkbook.sheets("Summary") ' wild guess, correct to your summary sheet name
Set Range_to_Copy = Sheet_Data.Range("D1")
Set Range_Destination = Sheet_Destination.range("A1")
Range_to_Copy.Copy Range_Destination 'this copies from range A to B (basically A.copy B), but i changed variable names to make it easier...
'more code, copies
'you can simplify without variables like this:
'Sheets("Sheet1").Range("D1").Copy Sheets("Summary).Range("A1") <===== does the same as the above coding
End Sub
Note that i never used activate or select, wich macro recorder will badly use all the time, making bad habits to starters.
Also, by referencing hard cell location like "D1", the code is not dynamic, if you add more data, the sub will have to be changed, so use this just as a start maybe

VBA Assistance needed. trying to select a range of cells, cut, move and paste

I have a spread sheet that is updated weekly. What i need to do is cut come of the cells and paste to a new location. I have never used macros or VBA before but I am getting frustrated with the amount of time I spend doing this. I know that I can use a macro but don't know how to write it.
I am trying to move the name of the hotel and resort to the left of the passengers title
R81C00 CHALET LE VALENTIN SAUZE D'OULX
MR HAYHOE 8
MR GLOVER 2
This repeats throughout the spread sheet. The number of lines between the names is dependent on information further right in the sheet.
546L
__________1 RESORT INFORMATION
__________5 SKI/S.BOARD CARRIAGE
__________8 AD L/P BRN BF 31/12/99
what I would like to do here is move these lines onto the same line as the flight number (this is the same line as passenger details) and then delete the lines with no data. this way all the details would be on the same line and then i would just need to fill down for the hotel names.
thanks in advance for any help please let me know if i haven't explained it clearly.
Trying to keep this general enough to be of use to other people, the basic process to follow would be:
find the next hotel/resort combination
find each passenger for that hotel/resort
add in the details for the other attributes
move on to the next passenger
move on to the next hotel/resort
If we start with finding the hotel/resort combination and we assume that this is on Sheet1 in column A in a single cell and that nothing else is in column A then we would need this macro:
Option Explicit
Sub main()
Dim lngCurrRow As Long
Dim lngMaxRow As Long
With ThisWorkbook.Worksheets("Sheet1")
lngMaxRow = .UsedRange.Rows.Count
For lngCurrRow = 1 To lngMaxRow
If (.Cells(lngCurrRow, 1).Value <> "") Then
MsgBox .Cells(lngCurrRow, 1).Value
End If
Next lngCurrRow
End With
End Sub
This should pop up a message box with the name of each hotel/resort in turn.
All the code does is work out how many used rows there are on the worksheet (and stores that in lngMaxRow) and then works through every used row (using lngCurrRow to keep track of which row we are on) checking the value of the cell in column A on that row (the .Cells(lngCurrRow, 1).Value part). If there is something in that cell (the (<> "" part) then it displays the value of that cell.
The more difficult case is when there is other data in column A (e.g. if the passenger names were also in column A). In that scenario, we need a way to easily recognise what is a hotel/resort combination and what is a passenger name but I don't have enough info about your current structure to determine how to do that