I have a table which looks like this (it changes dynamically).
I am trying to make a macro which would unlock only the "light yellow" cells = row 1 contains "Forecast" as a value and column I contains "Actual" as a value. I would later protect the sheet so the user would be able to change value only in these cells.
In conditional formatting I use this formula:
=(INDIRECT(ADDRESS(1;COLUMN();4))="Forecast")*(INDIRECT(ADDRESS(ROW();COLUMN($I$1);4))="Actual")
But I've failed to make something like this work in VBA.
Just in case anyone wondered how to do it.
Sub Lock_Cells()
Dim startCol As Long
startCol = WorksheetFunction.Match("Forecast", Range("1:1"), 0) 'Define in which column Forecast starts
Dim i As Long
For i = 2 To Range("I" & Rows.Count).End(xlUp).Row
If Cells(i, "I").Value = "Actual" Then 'Loop through values in column I
Range(Cells(i, startCol), Cells(i, "U")).Locked = False 'Unlock cells
End If
Next i
End Sub
Related
My Dataset is as such: Column A = ID numbers, Column B = Test Type, Column C = Results.
Each ID in Column A appears more than once. For each occurrence, there is a test with the result being either "Yes" or "No".
If one test result for a given ID comes back "Yes", I want to copy all rows for that ID to a new sheet in the same workbook.
So in the photo I've attached: ID 1234, test type Blue came back with "Yes", while test type Pink was "No". I want to copy both rows of ID 1234 to a new sheet because one or more of the tests (Blue or Pink) came back "Yes". ID 4321 should be left untouched because both tests were "No".
I've no idea on how to start this, I'm sure 'If, Then' statements may be involved.
Any suggestions how to tackle this in VBA?
Sheet with ID, Test Type and Results: an example but there would be about 1000+ rows of data.
Is this ok ?
Sub filter_and_copy()
' Variables
Dim oWsFrom As Worksheet
Dim oWsTo As Worksheet
Dim oRangeData As Range
Dim nbRow As Long
' Settings
Set oWsFrom = ThisWorkbook.Worksheets("sheet1")
Set oWsTo = ThisWorkbook.Worksheets("sheet2")
oWsTo.Cells.ClearContents
Set oRangeData = oWsFrom.Cells(1, 1).CurrentRegion
nbRow = oRangeData.Rows.Count
' Formula and filter
With oWsFrom
.Cells(1, 4).Value = "Formula"
.Cells(2, 4).Formula = "=COUNTIFS(A:A,A2,C:C,""yes"")"
.Cells(2, 4).AutoFill Destination:=.Range(.Cells(2, 4), .Cells(nbRow, 4))
.AutoFilterMode = False
.Rows(1).AutoFilter Field:=4, Criteria1:="1"
End With
' Copy
oWsFrom.Range(Columns(1), Columns(3)).SpecialCells(xlCellTypeVisible).Copy oWsTo.Cells(1, 1)
End Sub
This is the final code, which uses .Calculate to force the formula to work automatically every time I run the macro. Thanks again for the help
Worksheets("Total").Activate
'add column to put formula in
Range("B1").EntireColumn.Insert
Dim LstRwCD As Long
With ActiveSheet
LstRwCD = .Range("A" & Rows.Count).End(xlUp).Row
End With
Range("B2:B" & LstRwCD) = "=COUNTIFS(A:A,A2,N:N,""Yes"")"
Range(Range("B2"), Range("B" & LstRwCD)).FillDown
'This forces the formula to calculate
Worksheets("Total").Columns(2).Calculate
'filter if 1 or 2, all with at least one Yes in a pair.
Selection.AutoFilter
ActiveSheet.Range("A:T").AutoFilter Field:=2, Criteria1:="1", Operator:=xlOr, Criteria2:="2"
Worksheets("Total").Range("A1:T" & LstRwCD).Copy Worksheets("Total Yes").Range("A1")
'delete the columns with the formula
Sheets("Total Yes").Range("B:B").EntireColumn.Delete
Sheets("Total").Range("B:B").EntireColumn.Delete
Currently trying to debug my code. I want the first cell of the row to change a specific color based on the text in a cell in the same row. The text that is conditional is based in a drop-down list that the user manually inputs when the macro gets done running.
For polerow = 14 To lastrow + 12
If Cells(polerow, 27).Value = "Simple" Then
Cells(polerow, 1).Interior.ColorIndex = 5
'.Cells(PoleRow,1).Interior.Colorindex = 5
End If
Next
I basically am trying to write something in formula format. The text that is conditional is "Simple". Thanks!
I think that your issue is you have not set the lastrow, you also need to identify the workbook and sheet references.
Dim cel As Range, lastrow As Long
lastrow = ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count 'sets the number of used rows
'loop through each cell in Col27 from row 14 to the lastrow + 12
For Each cel In ThisWorkbook.Sheets("Sheet1").Range("AA14:AA" & lastrow + 12)
If cel.Value = "Simple" Then 'test cell value for condition
cel.Offset(, -26).Interior.ColorIndex = 5 'if condition is met then offset to first cell in row and color
End If
Next cel 'loop to next cell
I am trying to do the following in Excel:
The easiest way is of course to just drag and drop, but as I have many rows and columns, this is not feasible.
I was thus thinking that the following should work:
=IF(B6="Food", "Food", "insert two blank cells")
However, to my surprise, I was unable to find seomthing which would allow me to actually use "insert shift cells down" in a formula. What do I overlook, do I need to get started with VBA here?
Thanks!
I believe the following code would do what you expect:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your Sheet above
lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'find the last row with data on Column A
For i = 6 To lastrow 'loop from row 6 to last
If ws.Cells(i, 1).Value = "Food" Then 'if Food is found
ws.Cells(i, 2).Insert Shift:=xlDown 'insert a blank cell on Column B
ws.Cells(i, 2).Insert Shift:=xlDown 'again insert a second blank cell on Column B
End If
Next i
End Sub
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.
I have a spreadsheet that we are constantly adding data to. This data is imported from a report and added to the end of the spreadsheet. I have a macro already in place to remove duplicates. There is another macro that will highlight specific rows based on one of the cells contents, and then make a copy of the row and paste it into another sheet within the workbook. One of the columns requires a number as it's data. However, on occasion, this number is not available and we input "RCA Pending" into that cell.
What I need to do is have that cell highlighted in red. But, once the number is input into the cell, I need the cell color to change back to 'no fill', unless that row is highlighted from the previous macro that was run.
Expected result sample
I am not opposed to combining these macros if that is easier.
Here is the first macro listed above:
' This part highlights all rows that are Disputed
' Keyboard Shortcut: CTRL+SHIFT+L
Dim row As Range
For Each row In ActiveSheet.UsedRange.Rows
If row.Cells(1, "F").Value = "After Dispute For SBU" Then
row.Interior.ColorIndex = 6
Else
row.Interior.ColorIndex = xlNone
End If
Next row
' This part clears the Disputed worksheet and copies all disputed rows to the sheet
With ThisWorkbook.Worksheets("Disputed")
Range(.Range("A2"), .UsedRange.Offset(1, 0)).EntireRow.Delete
End With
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Master").Cells(Rows.Count, "A").End(xlUp).row
lr2 = Sheets("Disputed").Cells(Rows.Count, "A").End(xlUp).row
For r = lr To 2 Step -1
If Range("F" & r).Value = "After Dispute For SBU" Then
Rows(r).Copy Destination:=Sheets("Disputed").Range("A" & lr2 + 1)
lr2 = Sheets("Disputed").Cells(Rows.Count, "A").End(xlUp).row
End If
Range("A2").Select
Next r
Range("C" & Rows.Count).End(xlUp).Offset(1).Select
End Sub
How about just using conditional formatting on the data. You would use a formula like
=$A2="RCA Pending"
which assumes that the data starts in A2 and the column in question is A. You would need to select all of the columns in all of the rows, starting at A2, and then apply the CF