I have a table that I would like to resize dynamically in VBA.
My current code is this:
Sub resizedata()
Dim ws As Worksheet
Dim ob As ListObject
Dim Lrow1 As Long
Lrow1 = Sheets("Sheet4").Cells(Rows.Count, "J").End(xlUp).Row
Set ws = ActiveWorkbook.Worksheets("Sheet4")
Set ob = ws.ListObjects("Table28")
ob.Resize ob.Range.Resize(Lrow1)
End Sub
I would like to add one condition onto this though...
The table should resize to before the first 0 in column J.
For instance:
+-------+--------+-------+
|Date(I)|Hours(J)| Sal(K)|
+-------+--------+-------+
| Aug | 150000 | 12356 |
| Sep | 82547 | 8755 |
| Oct | 92857 | 98765 |
| Nov | 10057 | 45321 |
| Dec | 0 | 0 |
| Jan | 0 | 0 |
+-------+--------+-------+
The above table's last row should be the November row because December is the first 0 value in column J.
Can anyone assist in revising my existing code?
Something like:
With Sheets("Sheet4")
Lrow1 = .Cells(.Rows.Count, "J").End(xlUp).Row
Do While .Cells(Lrow1, "J").Value=0
Lrow1 = Lrow1 - 1
Loop
End With
This should help you to automatically resize the table.
With Worksheets("sheet-name").ListObjects("table-name")
.Resize .Range(1, 1).CurrentRegion
End With
Is there a particular reason you want to do this in VBA? You can simply create a defined name and use the following to create a self-adjusting range:
OFFSET(Sheet!$A$1,0,0,COUNTA(Sheet!$A:$A),COUNTA(Sheet!$1:$1))
OFFSET(reference, rows, cols, [height], [width])
The top line shows typical usage, 2nd line is the official syntax.
Go into Name Manager on the Formulas tab, click new, give it a name and paste the code into Refers to:.
One caveat, it looks as though your data has 0's where there are no values. If that is truly the case, you'll have to do a different test to determine height.
One benefit of this method is that it is always calculated. If the data changes then the size definition of your named range adjusts as needed.
I hope this is helpful, I use this a lot...
Related
We exported a customer's table who was using AirTable to keep track of their client's information and locations in an attempt to import into a SQL database. Because of the way AirTable exports, the references to other tables in their "AirTable Base" are not via ID's, but exported in a single column as basically power labels for lack of a better explanation.
There's about 4,000 client rows in this table. Clients can have one or more locations. Excluding many of the other columns it looks like:
| Client_ID | Client_Name | ... | Locations
| 3456 | Acme Grocery | ... | "Memphis, TN","Orlando, FL","Philadelphia, PA"
| 3457 | Addition Financial | ... | "Miami, FL","Plano, TX","New York, NY"
| 3458 | Barros Pizza | ... | "Queen Creek, AZ"
We are trying to get the data ready for import into SQL, so we are attempting to find a formula/method which could take the Client_ID and then insert that into rows in a new data sheet made from the comma-delimited column. Using the above example the new data should look like the following:
| ClientInLocation_ID | Client_ID | Location |
| 10000 | 3456 | Memphis, TN |
| 10001 | 3456 | Orlando, FL |
| 10002 | 3456 | Philadelphia, PA |
| 10003 | 3457 | Miami, FL |
| 10004 | 3457 | Plano, TX |
| 10005 | 3457 | New York, NY |
| 10006 | 3458 | Queen Creek, AZ |
Doing so will allow us to then grab the unique locations, assign ID's to them and then replace the Location text with a Location_ID field.
I was thinking pivot tables, text to rows, etc. but perhaps I'm not experienced enough with them to pull this off. Also, any solutions can obviously exclude the ClientInLocation_ID auto increment as we could always have that autofilled once the other two fields are populated. Any help greatly appreciated.
There are many ways to tackle this problem. You can use PowerQuery (PQ) to do some of the lifting if you have an appropriate version of Excel. PQ is built into recently released Excel versions and is a free add-on for Excel 2013 and 2010 but is not available for anything older than Excel 2010. If you see a Power Query tab on the ribbon then you're good to go.
Use your data as the source for a new query and split the location column by delimiter "," To clarify, you are using three characters as the delimiter: the last quote of a location, the comma delimiting two locations, and the first quote of the second location. This puts one location in a cell with subsequent locations in columns to the right.
Every cell in the first column well have a quote in front of the text and the cell holding the final location for that row will have a quote at the end of the text. This is easily cleared in PQ but we're done here so it's probably faster to click Save & Load to close the editor and use Ctrl+H in Excel to clear them.
Your data will automatically be converted into a table that is connected to your source data. That means that refreshing the table does two things: it wipes any edits you've made and it updates the table with any changes in your source data. So either delete the query (if this is a one and done project) or copy the table to a new sheet (if you want to rapidly rebuild with new source data)
From there, I'd turn to VBA and use three nested For loops. The outer loop iterates every row in your data from the bottom up (Step -1). The middle loop iterates the columns to add new rows. The inner loop populates the rows.
This is quick, dirty, makes several assumptions and is in no way tested because it was written on my phone:
Option Explicit
Sub TransformTable ()
Dim ws As Worksheet
Dim myTable As ListObject
Dim rng As Range
Dim j As Long
Dim k As Long
Dim l as Long
Set ws = ActiveSheet
Set myTable = ws.ListObjects(1)
Application.ScreenUpdating = False
For j = myTable.ListRows.Count to 2 Step -1
For k = 1 to Application.WorksheetFunction.CountA(ws.Range(ws.Cells(j,1),ws.Cells(j,myTable.ListColumns.Count) - 3
Set rng = ws.Cells(j,1)
myTable.ListRows.Add j+k
For l = 0 to 1
rng.Offset(k,l) = rng.Offset(0,l)
Next l
rng.Offset(k,3) = rng.Offset(0,3+k)
rng.Offset(0,3+k).Cells.Clear
Next k
Next l
Application.ScreenUpdating = True
End Sub
I know I can select a specific column in a pivot table in VBA using this:
pt.PivotSelect "Costs Alternative['1']", xlDataOnly, True
Set rng = Selection
Now, this is a bit annoying and not quite as fast and resilient as just going straight for:
Set rng = pt.PivotFields("Alternative").PivotFields("1").PivotItems("Costs").DataRange
My pivot table looks roughly like this:
+-------+-------------+--------+
| | Alternative | Values |
| | 1 | |
| Price | ft | Costs |
+-------+-------------+--------+
| 6.58 | 6.00 | 39.48 |
| 2.00 | 2.00 | 4.00 |
| 0.30 | 6.00 | 1.80 |
| Total | 14.00 | 45.28 |
+-------+-------------+--------+
Keep in mind that only one Alternative is listed in the data but in my actual pivot there are a lot more alternatives.
Is there a way to reference the pivot result value cell similar to the above?
here is a bunch of test code that i used to identify ranges in a pivot table
it just does .Select on each range so that the range is visible on the worksheet
some of the ranges are single cells, so .Select can be replaced by .Value
just step code with F8 key and watch the different ranges in the pivot table show up.
Sub pivot()
Dim piv As pivotTable
Set piv = ActiveSheet.PivotTables("PivotTable3")
piv.TableRange1.Select
piv.TableRange2.Select
piv.DataBodyRange.Select
piv.RowRange.Select
piv.ColumnRange.Select
piv.PageRange.Select
piv.PageRangeCells.Select
Dim aaa As Variant
aaa = piv.DataBodyRange.Value ' array
aaa = piv.DataBodyRange.Value2 ' array
aaa = piv.DataBodyRange.Formula ' array
piv.DataBodyRange.PivotField.LabelRange.Select
piv.DataBodyRange.PivotField.DataRange.Select
piv.DataBodyRange.Next.PivotField.LabelRange.Select
piv.DataBodyRange.Next.PivotField.DataRange.Select
piv.DataBodyRange.PivotItem.LabelRange.Select
piv.DataBodyRange.PivotItem.DataRange.Select
piv.PivotFields("Price").LabelRange.Select
piv.PivotFields("Price").DataRange.Select
piv.PivotFields("ft").LabelRange.Select
piv.PivotFields("ft").DataRange.Select
piv.PivotFields("Costs").LabelRange.Select
piv.PivotFields("Costs").DataRange.Select
End Sub
I loop through the Sheet via While, so when I find the string "Out" in the first row I delete the row.
The problem is that when I delete that column the next one goes to the deleted position and thus the loop will pass and wont delete it.
Can you help me?
Thanks
Sub DeleteCol()
xx = 37
Do While Worksheets("Data").Cells(1, xx) <> ""
Agrup = Worksheets("Data").Cells(1, xx)
Rubri = Worksheets("Data").Cells(2, xx)
If Agrup = "Out" Then
'Worksheets("Data").Columns(xx).Clear
Worksheets("Data").Columns(xx).Delete Shift:=xlShiftToLeft
End If
xx = xx + 1
Loop
End Sub
When deleting rows or columns you always need to loop backwards. Otherwise the current row/column position changes during delete.
This is because deleting always affects the position of rows/columns after the current row/column but not before. Therefore looping backwards does not affect our loop because un-processed rows/columns are before current row/column which are not affected by deleting.
Option Explicit 'very first line to ensure all variable are declared
Public Sub DeleteColumns()
Dim ws As Worksheet
Set ws = Worksheets("Data") 'define worksheet
Dim Argup As Range, Rubri As Range
Dim iCol As Long, lCol As Long 'iteration column, last column
Const fCol = 37 'first column
With ws '<-- use With statement
lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 'find last used column
For iCol = lCol To fCol Step -1 'loop from last column backwards to column 37
Agrup = .Cells(1, iCol)
Rubri = .Cells(2, iCol)
If Argup = "Out" Then
.Columns(iCol).Delete Shift:=xlShiftToLeft
End If
Next iCol
End With
End Sub
I also recommend to declare all variables and always use Option Explicit.
The answer is already posted, you need to delete from the end, rather than from the begining. But why? Lets image you have five columns, and you want to delete columns 2 and 4. Before deleting, this is how your columns look like:
Column index in loop: | 1 | 2 | 3 | 4 | 5 |
Original column number: | 1 | 2 | 3 | 4 | 5 |
Now you start from the begining...
Index 1: Do nothing (as intended)
Index 2: Delete (as intended)
Let's pause for a minute. Now let us see how deleting column 2 changed the picture:
Loop direction ---->
Column index in loop: | 1 | 2 | 3 | 4 | 5 |
Original column number: | 1 | 3 | 4 | 5 |
Now you might see that something is wrong. But lets continue the loop for the sake of the example:
Index 3: Do nothing (but this was originally column 4, and should have been deleted)
Index 4: Delete (but this was originally column 5, and should NOT have been deleted)
Index 5: Do nothing (depending on your code, you might get and out of bounds error)
Lets try to go backwards instead, maybe that helps:
Index 5: Do nothing (as intended)
Index 4: Delete
Let us pause, once again, to see how it looks now
<---- Loop direction
Column index in loop: | 1 | 2 | 3 | 4 | 5 |
Original column number: | 1 | 2 | 3 | 5 |
Well, something did shift. But as the next step in the loop is 3 (and we are going backwards), it doesn't really matter. Hope that helps the understanding a bit :-)
I've got an Excel workbook that obtains data from an MS SQL database. One of the sheets is used to check the data against requirements and to highlight faults. In order to do that, I've got a requirements sheet where the requirement is in a named range; after updating the data I copy the conditional formatting of the table header to all data rows. That works pretty nicely so far. The problem comes when I have more than one set of requirements:
An (agreeably silly) example could be car racing, where requirements may exist for driver's license and min/max horsepower. When looking at the example, please imagine there are a few thousand rows and 71 columns presently...
+-----+--------+----------------+------------+---------+
| Car | Race | RequirementSet | Horsepower | License |
+-----+--------+----------------+------------+---------+
| 1 | Monaco | 2 | 200 | A |
+-----+--------+----------------+------------+---------+
| 2 | Monaco | 2 | 400 | B |
+-----+--------+----------------+------------+---------+
| 3 | Japan | 3 | 200 | C |
+-----+--------+----------------+------------+---------+
| 4 | Japan | 3 | 300 | A |
+-----+--------+----------------+------------+---------+
| 5 | Japan | 3 | 350 | B |
+-----+--------+----------------+------------+---------+
| 6 | Mexico | 1 | 200 | A |
+-----+--------+----------------+------------+---------+
The individual data now needs to be checked against the requirements set in another sheet:
+-------------+---------------+---------------+---------+
| Requirement | MinHorsepower | MaxHorsepower | License |
+-------------+---------------+---------------+---------+
| 1 | 200 | 250 | A |
+-------------+---------------+---------------+---------+
| 2 | 250 | 500 | B |
+-------------+---------------+---------------+---------+
| 3 | 250 | 400 | A |
+-------------+---------------+---------------+---------+
In order to relate back to my present situation, I am only looking at either the Monaco, Japan or Mexico Race, and there is only 1 record in the requirements sheet, where the value in e.g. Cell B2 is always the MinHorsepower and the value in C2 is always the MaxHorsepower. So these cells are a named range that I can access in my data sheet.
Now however I would like to obtain all races at once, and refer conditional formatting formulas to the particular requirement.
Focussing on "Horsepower" in Monaco (requirement set 2), I can now find out that the min Horsepower is 250 and the max is 500 - so I will colour that column for car 1 as red and for car 2 as green.
The formula is programatically copied from the header row (the first conditional format rule is if row(D1) = 1 then do nothing)
I can't decide what the best approach to the problem is. Ideally, the formula is readable, something like `AND(D2 >= MinHorsepower; D2 <= MaxHorsepower) - I cannot imagine it to be maintainable if I had to use Vlookup combined with Indirect and Match to match a column header in requirements for that particular requirement - especially when it comes to combining criteria like in the HP example with min and max above.
I am wondering if I should read the requirements table into a dictionary or something in VBA, and then use a function like
public function check(requirementId as int, requirement$)
which then in Excel I could use like =D2 >= check(c2, "MinHorsepower")
Playing around with this a little bit it appears to be pretty slow as opposed to the previous system where I could only have one requirement. It would be fantastic if you could help me out with a fresh approach to this problem. I'll update this question as I go along; I'm not sure if I managed to illustrate the example really well but the actual data wouldn't mean anything to you.
In any case, thanks for hanging in until here!
Edit 29 October 2016
I have found a solution as basis for mine. Using the following code I can add my whole requirements table to a dictionary, and access the requirement.
Using a class clsRangeToDictionary (based on Tim Williams clsMatrix)
Option Explicit
Private m_array As Variant
Private dictRows As Object
Private dictColumns As Object
Public Sub Init(vArray As Variant)
Dim i As Long
Set dictRows = CreateObject("Scripting.Dictionary")
Set dictColumns = CreateObject("Scripting.Dictionary")
'add the row keys and positions. Skip the first row as it contains the column key
For i = LBound(vArray, 1) + 1 To UBound(vArray, 1)
dictRows.Add vArray(i, 1), i
Next i
'add the column keys and positions, skipping the first column
For i = LBound(vArray, 2) + 1 To UBound(vArray, 2)
dictColumns.Add vArray(1, i), i
Next i
' store the array for future use
m_array = vArray
End Sub
Public Function GetValue(rowKey, colKey) As Variant
If dictRows.Exists(rowKey) And dictColumns.Exists(colKey) Then
GetValue = m_array(dictRows(rowKey), dictColumns(colKey))
Else
Err.Raise 1000, "clsRangeToDictionary:GetValue", "The requested row key " & CStr(rowKey) & " or column Key " & CStr(colKey) & " does not exist"
End If
End Function
' return a zero-based array of RowKeys
Public Function RowKeys() As Variant
RowKeys = dictRows.Keys
End Function
' return a zero-based array of ColumnKeys
Public Function ColumnKeys() As Variant
ColumnKeys = dictColumns.Keys
End Function
I can now read the whole RequirementSet table into a dictionary and write a helper to obtain the particular requirement roughly so:
myDictionaryObject.GetValue(table1's RequirementSet, "MinHorsePower")
If someone could help me figure out how to put this into an answer giving the credit due to Tim Williams that'd be great.
I'm a newbie. I have an excel file with 10 sheets, 6 sheets named after 6 employee names the next 3 with some information (irrelevant to my code) and the 10th sheet named Temp.
The employee sheets have the following data in each column (D&E are blank):
| A | B | C | D | E | F |
| 17-Sep-13 | ProjectA | 6 | | | Report updated on this day |
| 18-Sep-13 | CBL Ideas - HMF | 7 | | | |
| 18-Sep-13 | CBL Ideas - HMF | 1 | | | |
I want to have all these data collated in the sheet named Temp as follows:
| A | B | C | D |
| 17-Sep-13 | Project A | 6 | foo |
| 18-Sep-13 | Project A | 7 | foo |
| 18-Sep-13 | Project B | 1 | foo |
| 17-Sep-13 | Project A | 6 | bar |
| 18-Sep-13 | Project A | 7 | bar |
| 18-Sep-13 | Project B | 1 | bar |
Below is my code:
Sub ListRelevantEntries()
Dim s As Integer
Dim C As Range
For s = 1 To Worksheets.Count - 4
If Sheets(s).Cells(Rows.Count, "F").End(xlUp) _
.Value = "Report last updated on this day" Then
'Execution stops on the below line with an
' "Application-defined or object defined error"
Sheets(s).Range(Cells(Rows.Count, "F").End(xlUp) _
.Offset(1, 0), Cells(Rows.Count, _ "A").End(xlUp)) _
.Copy(Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0))
Sheets("Temp").Select
Sheets("Temp").Cells(Rows.Count, "C").End(xlUp).Offset(0, 1).Select
For Each C In Sheets("Temp").Range(Cells(Rows.Count,"C").End(xlUp). _
Offset(0, 1), Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)).Cells
C = Sheets(s).Name
Next
ElseIf Not Sheets(s).Cells(Rows.Count, "F").End(xlUp) _
.Value = "Report last updated on this day" _
And Not Sheets(s).Cells(Rows.Count, "F").End(xlUp).Value = "" Then
MsgBox "Extra Words entered " & ActiveSheet.Cells(Rows.Count, "F") _
.End(xlUp).Offset(1, 0).Value & " in " & Sheets(s).Name
End If
Next
Sheets("Temp").Range("1:1").Delete
End Sub
Sorry for such a long question. I couldn't think of any other way to explain!
The error will be a lot easier if you clean up your code. Add a worksheet variable at the start
Dim ws As Worksheet
Then after the first For statement assign the target sheet to it
Set ws = Worksheets(s)
Notice I used Worksheets(s) not Sheets(s). They are different, don't mix them. The Sheets collection can include Charts as well as Worksheets, it represents every tab. The Worksheets collection only contains Worksheet objects. In your For loop you used Worksheets, then you used Sheets within the loop. This will break if any charts are in the workbook.
Okay, so now that you have this ws variable containing a reference to the worksheet, go ahead and replace all your Sheets(s) with ws inside the for-loop's body. While you are at it, fix all your calls to Cells and Rows. Anywhere you write something like ws.Range(Cells(1, "F")) you are making a mistake. Cells alone points to ActiveSheet.Cells where as you want ws.Cells. Otherwise you are trying to create a cross-worksheet range any time ws is not ActiveSheet. The same goes for other properties of a range, such as Rows. So now the line of code you're stopping on should be more like this:
ws.Range(ws.Cells(ws.Rows.Count, "F").End(xlUp) _
.Offset(1, 0), ws.Cells(ws.Rows.Count, "A").End(xlUp)) _
.Copy Sheets("Temp").Cells(Sheets("Temp").Rows.Count, "A") _
.End(xlUp).Offset(1, 0)
Notice, I also removed the parentheses around the parameter you're passing to .Copy. In VBA you call a method without parentheses unless it returns a value. So MyMethod "Value to pass" or result = MyMethod("Value to pass") but not MyMethod("Value to pass").
After fixing all that, if it still is producing the error, I'd recommend using the debugger. Open the watch window and start breaking the offending line into bits, examine them, and find the problem.
So first you might create a watch for ws and make sure it's the correct sheet. Then maybe edit that watch to be ws.Cells(ws.Rows.Count, "F").End(xlUp) and see if that is getting the correct cell.
Oh, also, if you're doing it properly you shouldn't need to call anything like Worksheet.Select or .Activate. In fact, it's recommended you avoid those the vast majority of the time, unless you are interacting with the user by changing their view.
Replace with something like
With Sheets(s)
.Range(.Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0), .Cells(.Rows.Count, "A").End(xlUp)).Copy Sheets("Temp").Cells(Sheets("Temp").Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
you get the error since you did not return the reference to the sheet(s).
A quick fix is to add this:
Sheets(s).Select
prior line 6 or after line 4.
But for better coding, try using whats seen in This Thread.
That link discusses how you can avoid using select by declaring and setting all your objects.