I can't figure out the right logic for the VBA to set (hide or show) the columns in some area (columns K to O) based on the "template" area (columns C to G).
In the example below, I hid the column D and I would like to run a code that would scan what columns in range C3 to G3 are hidden or shown and accordingly (show or hide columns) edit the columns in range K3 to O3, which in this example means hiding the column L.
I can work with ranges and can further edit the code for my purposes, but I just don't know how to somehow save the column structure in the template and replicate it in the second area.
Also, there will be formulas in the template and nulls in the edited area, but I think I can do this adjustment on my own.
I will be grateful for any idea.
Hide Columns With Offset
Option Explicit
Sub hideCols()
Const src As String = "C:G"
Const dst As String = "K:O"
Dim n As Long
For n = 1 To Columns(dst).Count
Columns(dst).Columns(n).Hidden = Columns(src).Columns(n).Hidden
Next n
End Sub
Try the next code, please:
Sub testHideUnhide()
Dim sh As Worksheet, rng As Range, cel As Range
Set sh = ActiveSheet 'use here your sheet, if not the active one
Set rng = sh.Range("C3:G3")
For Each cel In rng.cells
cel.Offset(0, 9).EntireColumn.Hidden = cel.EntireColumn.Hidden
Next
It will hide and unhide the columns in rage "K:O" according to "C:G" situation, from this point of view.
Related
When formula result changes in my table in column K range ("K2:K5") I want the entire row in the table to be filled with a color. But I only want the row to be colored if the result is not equal to 0.
So eg. if the result changes in K2 (and is not = 0) the entire row A2:L2 will be colored.
The formula are refering to values that you select from dropdown-lists (created from "data validation" on the excel menu Data-tab). These dropdowns are located on the same row (eg. “D2:J2”) as the related formula. The values in the dropdown is refering to a range on the same sheet outside of the table.
So far I have one code for the worksheet concerning the change event that calls the module with the sub that will change the color on the row.
But it doesn't work and I get no error messages.
This is the code for the worksheet change event:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "§D2:§J2" Then
Color_Row
End If
End Sub
Here the target address should propably be the whole range, but I don't know how to give the right syntax for that.
Here is the code for changing color on row:
Sub Color_Row()
Dim r As Long, c As Long 'r=rows in the excel sheet | c= value of cell in _
column k
Dim numrow As Long 'last row with data
Dim tblR As Long 'tablerow
numrow = TimeMeasure.Range("K" & Rows.Count).End(xlUp).Row
For r = 2 To numrow
tblR = r - 1
c = Cells(r, 11).Value
If c <> 0 Then
[TimeDist].Rows(tblR).Interior.Color = 12961279
Else
[TimeDist].Rows(tblR).Interior.Color = xlNone 'no fill color
End If
Next
End Sub
I have steped in to this code and watched variables like c, r, numrow, tblR and it all seems to match my table (the name of my table is TimeDist).
The only thing that I've noticed is that no values ever assigns to c in the loop. I know though that this code works in another workbook, but then I manualy type in a new value in a specific cell outside of the table, which changes the formula result in table (then the rows get colored)
I very thankfuly accept any help on this.
Many thanks for all your inputs which has helped me to solve it! :)
It now works like a charm!
This worksheet_calculate code does the job (I have changed my cell range though):
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("L2:L5")
If Not Intersect(Xrg, Range("L2:L5")) Is Nothing Then
Color_Row
End If
End Sub
So I'm working on an excel sheet, and this is something i really can't figure out.
I want it to be that if the contents of a cell match certain criteria, an entire column of cells will be pasted according to that cell. The cell is a drop down with 32 different options (that can be reduced if theres no way to do it) and each option corresponds to a different column of data. The columns that have to be pasted have roughly 32 cells of data each.
My current formula is basically =IFS(A1="Potato",Sheet2!G:G) but this gives me a '0'. The best i can do is change the formula to =IFS(A1="Potato",Sheet2!G1) or =IFS(A1="Potato",Sheet2!G1:G32) but both of these formulas give me the contents of the first cell only (G1).
Any ideas on how I could get this done without having to contact aliens or build a spaceship?
You can use formulas, or VBA.
I have assumed your 32 columns of source data are in Sheet2 with the headers in row 1.
Formula Solution
In Sheet1 A73, enter:
=INDEX(Sheet2!$A$1:$AF$41,ROW(A1),MATCH($A$1,Sheet2!$A$1:$AF$1,0))
Copy this formula to Sheet1 A74:A105
VBA Solution
Put this code in the Sheet1 module;
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.EnableEvents = False
With Sheet2
Set c = .Rows(1).Find(what:=Sheet1.Range("A1").Value)
If Not c Is Nothing Then
Set c = Intersect(.UsedRange, c.EntireColumn)
Sheet1.Range("A73").Resize(c.Rows.Count, 1).Delete
c.Copy Sheet1.Range("A73")
End If
End With
Application.EnableEvents = True
End If
End Sub
EDITED ANSWER: (according to comment)
We have the following layout of products
Private Sub CommandButton1_Click()
'first we check the user input
Dim u_input As String
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
u_input = LCase(Trim(ws.Range("A1").Value2))
'now we need to determine how many columns there are so we know when to stop looping
Dim lc As Long, lr As Long
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' loops through all the products
For Each cell In Range(Cells(1, "F"), Cells(1, lc))
' if the product matches the input
If LCase(Trim(cell)) = u_input Then
lr = ws.Cells(ws.Rows.Count, cell.Column).End(xlUp).Row
' copy and paste the active data range to A37
ws.Range(Cells(1, cell.Column), Cells(lr, cell.Column)).Copy
Sheets("Sheet2").Range("A37").PasteSpecial
End If
Next cell
End Sub
So, upon entering cucumber and clicking the button:
We would get the following result:
You can add any number of products there, as long as the first product starts in column F. (though that can also be changed in code).
PS: This will however end up overwriting your data and also cause data to overlap if your data ranges are not the same. It probably would be smarter to paste the data into the next empty row in sheet2 instead of directly to A37
This can be achieved by changing the line
Sheets("Sheet2").Range("A37").PasteSpecial to Sheets("Sheet2").Range(Cells((Rows.Count, "A").End(xlUp).Row, "A")).PasteSpecial
I use Excel tables a lot. It makes it possible to have multiple tables in one worksheet. But I have got into a problem in VBA which I do not know how to solve.
Let us say that I have a table called "tbl" in my spreadsheet. It contains the following data:
id value
1 1000
1 2000
2 3000
2 4000
I have the following code which works:
Sub test()
Dim rng As Range
Dim arr() As Variant
Set rng = ActiveSheet.ListObjects("tbl").DataBodyRange
arr = rng.Value
End Sub
This code will put the whole table into arr. But there are situations where I only want some rows in the table. Let us say that I want row 4 and 5 i.e:
2 3000
2 4000
The following code will do the trick:
arr = Range("A4:B5")
But there are cases where I have many tables located in different places in my spreadsheet. Therefore I need to work out where the first cell in the table is located (upper left). If it is located in K1, I need to get both the column and the row (K and 1).
Is there an easy way to do this?
Use Cells():
Sub test()
Dim rng As Range
Dim arr() As Variant
Set rng = ActiveSheet.ListObjects("tbl").DataBodyRange
arr = ActiveSheet.Range(rng.Cells(3, 1), rng.Cells(4, 2)).Value
End Sub
If you just want the third and fourth data rows (i.e. fourth and fifth rows if you count the heading row), you could use
Sub test()
Dim rng As Range
Dim arr() As Variant
Set rng = ActiveSheet.ListObjects("tbl").DataBodyRange
arr = rng.Rows("3:4").Value
'or
arr = rng.Range("A3:B4").Value
End Sub
Because the Rows and Range properties are being applied to the rng object, the references ("3:4" and "A3:B4") are relative to the start of the rng object.
So you could also get the worksheet address of the first cell in rng by using rng.Range("A1").Address (or rng.Cells(1, 1).Address), or you can get the first cell's worksheet row and column by just using rng.Row and rng.Column respectively (they both default to returning the value for the first cell).
The first cell in a table has some unique properties:
-It is not empty
-The cell above it is null
-The cell to the left of it is null
-The cell below it is not null
Using these properties you can do something like:
1) Loop over every cell
2) If that cell has the above properties, then it is a "top left" cell
3) Do whatever with that table
I have data in columns A:I. The data in column A will always go through to the last row, but other rows in other columns will sometimes be blank. How do I select the range based on the last row in column A? For example, sometimes column A will have 40 rows of data but column I will be blank after row 3. I would still want to select A1:I40.
Ultimately, I want to use VBA to format and put a filter on this range, so I am hoping to not include any blank rows after the last used row in column A.
Consider:
Sub qwerty()
Dim N As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:I" & N).Select
End Sub
Gary's Student gave you the answer
maybe you're interested in expanding the feature and want to consider the last row with at least one non blank cell in the whole columns range (columns "A:I" in your example), irrespective of which column has it, than you could use:
Function LastRow(sht As Worksheet, columnsStrng As String) As Long
With sht
With Intersect(.UsedRange, .columns(columnsStrng)).SpecialCells(xlCellTypeConstants)
LastRow = .Areas(.Areas.Count).Row
End With
End With
End Function
and here follows an example of how to use it
Option Explicit
Sub main()
Dim ws As Worksheet
Set ws = Worksheets("mysheet1")
ws.columns("A:I").Resize(LastRow(ws, "A:I")).Select
End Sub
This assumes your data are constants (i.e. actual cells content is not a "formula").
But it can be easily enhanced to consider "formula" data as well
What I have been doing previously is manually selecting and then copy/paste raw data from a report into a sheet titled "ImportDump". From here I use VBA to select and copy the 11 ranges I am interested in across to specific locations in Sheet1 and Sheet2. I would explicitly state the ranges that the data occupy in the ImportDump sheet and copy them across. This worked but is no longer simple to do.
Instead, I plan to search for each table heading in Column A in the ImportDump sheet using the Find method, and then use the result of Find, plus an offset, as the starting position of a dynamic range. So for example, the string "Capital Premier" is found in A30, but the range I need starts in B33. I then need all rows down to the next blank cell in Column B, and all columns across to the next blank column (data always finishes in Column J). And then repeat for all further 11 heading strings. The headings will all appear in Column A, all the tables will have the same offset from the search string result (3,1), and the same number of columns (9), but not necessarily the same number of rows.
I think I know how to do the search IDump.Range("A1:A200").Find(What:="Capital Premier", LookIn:=xlValues, LookAt:=xlPart), and I'm pretty sure I can use .End(xldown) to select down to the next blank row, but I'm not sure how to combine all that with an offset to express the starting location of my dynamic range. Could someone please help me to solve this?
Edit: I've found my ideal solution (unless someone comes up with something even better)
This code combines a look at a table on one sheet ("Instructions") for a user-defined string, a search for the string in a separate sheet ("ImportDump" - a raw data dump), once the string is found it jumps to an offset cell location (3,1), finds the last row and last column before the next blank, selects the range outlined by the offset location, lastrow and lastcol, copies the range to a location (Sheet, then Cell) defined in the initial search table that corresponds to the search string. It then loops through all the rest of the user-defined strings until the last row of the table in the "Instructions" sheet, finding the ranges and pasting them into the corresponding predetermined locations. Thanks for everyone's input!
Sub ImportLeagueTables()
Dim r As Range
Dim i As Integer
Dim IDump As Worksheet
Dim Instruct As Worksheet
Dim what1, where1, where2 As String
Dim TeamRng, TableRng, f, g As Range
Dim LastRowTeam As Long, Lastrow, Lastcol As Long
Set Instruct = Sheets("Instructions")
Set IDump = Sheets("ImportDump")
LastRowTeam = Instruct.Range("M4").End(xlDown).Row
Set TeamRng = Instruct.Range("M4:O" & LastRowTeam)
i = 1
For Each r In TeamRng.Rows 'rows to loop through
what1 = TeamRng.Range("A" & i) 'the string to find
where1 = TeamRng.Range("B" & i)
where2 = TeamRng.Range("C" & i)
Set f = IDump.Columns(1).Find(what1, LookIn:=xlValues, LookAt:=xlPart)
Set g = f.Offset(3, 1)
Lastrow = g.Range("A1").End(xlDown).Row
Lastcol = g.SpecialCells(xlCellTypeLastCell).Column
Set TableRng = IDump.Range(g, IDump.Cells(Lastrow, Lastcol))
TableRng.Copy
Sheets(where1).Range(where2).PasteSpecial xlValues
i = i + 1
Next r
End Sub
Original, less robust solution: Ok, I've come up with a workable solution by explicitly defining the range with reference to the first cell i.e. Set g = f.Offset(3, 1) and Set CapPremRng = g.Range("A1:I10"), although that's not as elegant as I would like. Would prefer to use g to select all cells down and across until the next blank row/column.
Full code:
Sub DoMyJob()
Dim IDump As Worksheet
Dim f As Range
Dim g As Range
Dim CapPremRng As Range
Set IDump = Sheets("ImportDump")
Set f = IDump.Range("A1:A200").Find(What:="Capital Premier", LookIn:=xlValues, LookAt:=xlPart)
Set g = f.Offset(3, 1)
Set CapPremRng = g.Range("A1:I10")
CapPremRng.Copy
Sheets("Sheet3").Range("A1" & LastRow).PasteSpecial xlValues
End Sub