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
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
I have a large spreadsheet of various chemicals and their specifications; however, not every chemical requires a value in each column so there are a lot of blank cells. I'm wondering if there's something I can do to hide a column if there are no values in it when I select it from a drop-down list filter?
For example, I click on the drop-down list and select "potassium hydroxide" and I want it to hide the columns "Moisture" because there are no values in it.
what it looks like now:
I tried using some VBA code earlier but I don't seem to get how to incorporate it into the drop-down list filter.
Unfortunately, there is no Event for a filter being applied/changed to fire off a macro. However, you can manipulate the Event, Worksheet_Calculate, to achieve desired result since modifying a filter calculates the sheet. I.E. every time the sheet calculates, the macro is triggered!
So now we need to link a filter to a calculation. Any equation will do for this so I am just setting K1 = L1 in my example. Ideally, this will be somewhere out of sight (Ideally next to your last used column header to avoid hiding columns not being used)
The macro is making use of the Aggregate function by counting the instances of non-empty cells for visible rows only. When a filter is applied, any columns that only have 1 visible cell will be hidden. We are using 1 as a base line since all columns will at least have 1 visible cell due to header.
Paste the below code in VBE on sheet Specifications. This will not work in a module or workbook template.
Option Explicit
Private Sub Worksheet_Calculate()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Specifications")
Dim LCol As Long: LCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
On Error GoTo SafeExit
Dim HeaderCell As Range
Application.ScreenUpdating = False
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
For Each HeaderCell In ws.Range(ws.Cells(1, 1), ws.Cells(1, LCol))
If Application.WorksheetFunction.Aggregate(3, 7, HeaderCell.EntireColumn) = 1 Then
HeaderCell.EntireColumn.Hidden = True
End If
Next HeaderCell
SafeExit:
Application.ScreenUpdating = True
End Sub
TLDR
Make sure Sheet has at least 1 equation. When you apply/modify a filter, you force a calculation. When you force a calculation, you trigger the macro. When you trigger the macro, you hide all columns that only have 1 visible cell (which will be the header).
If this runs slow, you can add your range to a Union of columns and hide the Union (all columns meeting your criteria) once loop is complete.
Much in the line of #urdearboy, I'd go as follows
place the following formula in any cell in row 1:
=SUBTOTAL(3,A:A)
then place the following code in the "Specification" sheet code pane:
Private Sub Worksheet_Calculate()
Dim col As Range
With Me.UsedRange
For Each col In .Offset(, 1).Resize(, .Columns.Count - 1).Columns
col.EntireColumn.Hidden = Application.WorksheetFunction.Subtotal(103, col) = 1
Next
End With
End Sub
as you may notice, since the same chemical can appear more than one in in column A (e.g.: "Sulfamic Acid"), a column gets hidden only if all of its visible cells are empty
try this code:
For i = 1 To 500
If Application.WorksheetFunction.Count(Columns(i)) = 1 Then
ActiveSheet.Columns(i).Hidden = True
End If
Next
I have the example where I want to write a VBA statement which will select all data in a single column, there are no blanks in the column data. The column position will never change e.g. column A, and the data starts in row 3. However the total number of rows in the column will change regularly.
I want the system to dynamically select all the cells in column and then I can run a method against these selected pieces of data.
As an example of performing an action on your range without selecting it:
Public Sub Test()
Dim rColA As Range
With ThisWorkbook.Worksheets("Sheet1")
Set rColA = .Range(.Cells(3, 1), .Cells(.Rows.Count, 1).End(xlUp))
MsgBox "Column A range is " & rColA.Address 'Delete if you want.
rColA.Interior.Color = RGB(255, 0, 0) 'Turn the back colour red.
rColA.Cells(2, 1).Insert Shift:=xlDown 'Insert a blank row at second cell in range
'So will insert at A4.
'If the first cell in your range is a number then double it.
If IsNumeric(rColA.Cells(1, 1)) Then
rColA.Cells(1, 1) = rColA.Cells(1, 1) * 2
End If
End With
End Sub
Try
Dim LastRow as Long, sht as worksheet
Set sht = ThisWorkbook.Worksheets("My Sheet Name")
LastRow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
sht.Range("A3:A" & LastRow).Select
Like Darren Bartrup-Cook says, you may not need to select the data, you can almost always perform actions directly which is much faster.
If your column is "isolated" meaning no other nonblank cells touch your data you can use:
Range("firstCellInYourColumn").CurrentRegion.Select
(this works the same way as Ctrl+* from keyboard)
otherwise use:
Range(Range("firstCellInYourColumn"), Range("firstCellInYourColumn").End(xlDown)).Select
both will work if there are really no blanks within your data.
You should also prepend all Range with worksheet expression, I omitted this.
So I have a big excel sheet with a bunch of empty cells in various locations. I want an easy to work with list of which cells are empty. I was hoping to make a new worksheet that was populated with the locations of the empty cells. I wanted to have this to just populate the cells I want it to. I kept the header from the worksheet I will be checking and added a blank cells count, so I want the following cells in the column to be populated by the list of empty cell locations.
Now I know I can use =ISBLANK to test if a cell is empty or not, but I only care about the cells that return TRUE. So I figure I'll need a loop. And I want the location of the cell so I can use =CELL. And to make this most readable I want to do this on a column by column basis.
But I want to populate a spreadsheet with this information in a manner similar to how functions work (I just want to copy and paste it to other cells and columns). But it's pretty clear that I am going to need VBA.
My question is how can I create a macro to populate my spreadsheet with a list of empty cells? How do I apply it to the cells?
I assume you have data in sheet1, I have used sample range// Range("A1:c15") however you can define range as per need and blank cells address will be published in next sheet.
Sub FindBlank()
Dim rng As Range
dim i as long
For Each rng In Sheet1.Range("A1:c15").SpecialCells(xlCellTypeBlanks)
i = i + 1
Sheet2.Cells(i, 1) = rng.Address
Next
End Sub
If you want a list of the cells that are empty, you can use Range().SpecialCells(xlCellTypeBlank):
Sub getEmptyCellAddresses()
Dim rng As Range
Dim ws as Worksheet
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15").SpecialCells(xlCellTypeBlanks) ' Edit/change range as necessary
ws.Cells(1, 2).Value = rng.Cells.Address ' Change `ws.cells(1, 2)` to whatever destination you like
End Sub
Edit: Ah, beaten by 16 seconds by #RamAnuragi ...but anyways, they're slightly different ways to tackle the question so I'll leave it.
Edit: For funsies, here's another way to put them all in a column, one row per cell...and more, per your comments.
Sub listEmptyCells()
Dim emptyAddresses() As String
Dim i As Long
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15")
If WorksheetFunction.CountBlank(rng) = 0 Then
MsgBox ("No empty cells in the range")
Exit Sub
End If
emptyAddresses() = Split(rng.SpecialCells(xlCellTypeBlanks).Address, ",")
For i = LBound(emptyAddresses) To UBound(emptyAddresses)
ws.Cells(i + 1, 2).Value = emptyAddresses(i)
Next i
End Sub
I have a spreadsheet I'm using to compile text that changes all the time.
In column AD, Row 4(AD4) I put the contents of text, and it can have data going 1000 to 4000 rows down. It changes every time, so there is no static range name. I need a macro that
finds the final piece of data in that column,
then automatically "drags a box" from that spot two columns to the left (AB4)
and copies it... (A 3000 row piece of text would be AB4:AD3004) (Macro stops there, with text to be copied highlighted)
The current version finds the bottom cell correctly, but if I run the macro a 2nd time, with new data, it keeps trying to copy the same range. (I used the Formula Define.Name method, to name the cell, and then selected AB4:LastRow) but it is ALWAYS 3160 whether data goes to row 4000 or not.....
Sub Last_row()
Cells(Application.Rows.Count, 30).End(xlUp).Select
' following lines of code are useless
Range("AB4:AD3160").Select
Range("AD3160").Activate
Selection.Copy
End Sub
To answer your question directly:
With Sheet1
.Range("AB4", .Cells(Rows.Count, "AD").End(xlUp)).Copy
End With
Copy to specific location WITHOUT using clipboard:
With Sheet1
.Range("AB4", .Cells(Rows.Count, "AD").End(xlUp)).Copy Sheet2.[A1]
End With
Copy and exclude formatting:
With Sheet1
With .Range("AB4", .Cells(Rows.Count, "AD").End(xlUp))
Sheet2.Cells(1, "A").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
End With
Note: Replace all sheet codenames (sheet1, Sheet2) above with your actual sheet codenames.
Your current code hard-codes the range of interest with
Range("AB4:AD3160").Select
This code will define a dynamic range starting from AB4 to the last non-empty cell in column AD
You can then use this range (without selecting) for changing values elsewhere (note that you may not need to actually copy rng1, it is possible to dump these values to a separate range directly without a copy and paste.
Sub Last_row()
Dim rng1 As Range
Set rng1 = Range([ab4], Cells(Rows.Count, 30).End(xlUp))
rng1.Copy
End Sub
Update: Example of how to copy a dynamic sized range from one sheet to another without a copy and paste:
Sub Last_row2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
Set rng1 = ws1.Range(ws1.[ab4], ws1.Cells(Rows.Count, 30).End(xlUp))
ws2.[a1].Resize(rng1.Rows.Count, rng1.Columns.Count).Value = rng1.Value
End Sub