I have a sheet "2018" and "2019" which i created previously. 2019 only differs from 2018 in that it may have some rows added and/or some deleted.
Form Cell "A3" and downwards i have skills listed and a "X" in the columns after if the person the column belongs to has this skill.
Now i need to fill the columns of 2019 with known X with formula below, first a bit of context code for the range selection part:
Dim rng As Range
Dim rngbegin As Range
Dim rngend As Range
Dim newrng As Range
Sheets("2018").Activate
Set rng = Application.InputBox '...and rest of the code
rng.Copy
Sheets("2019").Range("B:B").Insert Shift:=xlToRight
Sheets(2019).Activate
Set rngbegin = rng.Cells(3, 1)
Set rngend = rng.Cells(3000, rng.Columns.Count)
Set newrng = Range(rngbegin.Address & ":" & rngend.Address)
newrng.ClearContents 'To clear everything in the difined range but the headder rows
Here is a formula i could use if the columns wouldn't be varying.
Range("B3").Select
ActiveCell.Formula = "=IFERROR(LOOKUP(2,1/($A3='2018'!$A$3:D$5000),'2018'!$B$3:$B$5000),"")"
Range("B2").AutoFill Destination:=Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)
The Formula works but i have the following problems:
1 - Required) I can't hardcode the formula for every column because the number of colums may change. (I store the number of columns as range var selected from the user via application.inputbox - that's how i inserted the colums in the new 2019 sheet)
2 - optional) I hardcoded the rows to a much higher number than are used because i didn't thnk of counting Column A and then use the range.count.Address(?) as end of the search vector. Just came into my mind lol
You will probably need to tweak a few addresses. I left much of your code unchanged so you can easily adapt what I have came up with for your purposes.
Sub Whatever()
With Sheets("2018")
' Get the address of the old range, not used later in the macro
iRows = .Cells(Rows.Count, 1).End(xlUp).Row
iCols = .Cells(3, Columns.Count).End(xlToLeft).Column
Set rngOld = Range(.Cells(3, 2), .Cells(iRows, iCols))
End With
With Sheets("2019")
' Get the address of the new range
iRows = .Cells(Rows.Count, 1).End(xlUp).Row
iCols = .Cells(2, Columns.Count).End(xlToLeft).Column
Set rngNew = Range(.Cells(3, 2), .Cells(iRows, iCols))
'Clear the new range
rngNew.Clear
' Populate the formula
' Not very elegant, VBA solution would probably look nicer
.Range("B3").Formula = "=IFERROR(if(LOOKUP(2,1/('2018'!$A$3:$A$" & iRows & " =$A3),'2018'!B$3:B$" & iRows & ")=""X"",""X"",""""),"""")"
'Fill the formula
Set rngTemp = .Range(.Cells(3, 2), .Cells(3, iCols))
rngTemp.FillRight
Set rngTemp = .Range(.Cells(3, 2), .Cells(iRows, iCols))
rngTemp.FillDown
End With
End Sub
Related
I am making a project planning worksheet and writing a function to add a team member that inserts a number of grouped cells for summing up hours per week.
The new cells should have a conditional format to show when the total actual hours worked (shown in blue) exceed the planned hours worked (column M).
Example
Manage Rules Box
I am having some trouble using the range that I define in Formula1:
When I run the program, it does define the conditional format, but the formula shown in "manage rules" shows the name of the range, not the cells I am trying to format.
Any and all help is greatly appreciated!
I have defined the range of cells to be formatted, but it doesn't seem to translate to actual cell selections when using MyRange.FormatConditions.Add Type:=xlExpression, Formula1:="=sum(MyRange)>FmtHrs"
Sub Button1_Click()
Dim iCol As Long
Dim WeekCount As Long
Dim LastCol As Long
Dim RowCount As Integer
Dim FmtRow As Long
Set ws = Sheet1
'This sections adds new staff member info'
'This sections adds weeks for new staff memeber'
WeekCount = Range("B3").Value 'number of columns to add (weeks of project in B3)'
LastCol = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column 'position of new columns at last column with data'
Columns(LastCol + 1).Insert Shift:=xlToRight
For i = 1 To WeekCount 'inserts columns for each week of project'
Columns(LastCol + 1).Insert Shift:=xlToRight
Next i
'insterns column for new staff and adds labels'
LastCol = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column + WeekCount + 1
ActiveSheet.Cells(3, LastCol).Value = "Role"
ActiveSheet.Cells(4, LastCol).Value = "Name"
ActiveSheet.Cells(5, LastCol).Value = "Rate"
'Groups New Columns
LastCol = ActiveSheet.Cells(3, Columns.Count).End(xlToLeft).Column
Range(Cells(1, LastCol - WeekCount), Cells(1, LastCol - 1)).Columns.Group
ActiveSheet.Outline.ShowLevels ColumnLevels:=1 'collapses all groups
'Adds Conditional Formats to New Rows
RowCount = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
FmtRow = RowCount
Dim FmtHrs As Long
Dim MyRange As Range
Dim condition1 As FormatCondition
For i = RowCount - 1 To 6 Step -1
FmtHrs = ActiveSheet.Cells(FmtRow, LastCol)
Set MyRange = Range(Cells(FmtRow, LastCol - WeekCount), Cells(FmtRow, LastCol - 1))
MyRange.FormatConditions.Add Type:=xlExpression, Formula1:="=sum(MyRange)>FmtHrs"
MyRange.Interior.Color = RGB(128, 100, 250)
FmtRow = FmtRow - 1
Next i
End Sub
You write "=sum(MyRange)>FmtHrs" as formula to the conditional formatting. In Excel, MyRange has no meaning, that's a VBA variable. What you want is to write the range address into the formula.
An advice: don't write the formula directly, always use an intermediate variable, that makes it much easier to check if something does not work as expected
Dim formula As String
formula = "=sum(" & MyRange.Address & ")>FmtHrs"
MyRange.FormatConditions.Add Type:=xlExpression, Formula1:=formula
I am having trouble grasping how the operation I'm about to describe can be conceptualized, since I am new to coding.
A big spreadsheet includes 100 columns, and those need to be condensed down to 10 by adding together the columns. There is a key, so that all the columns tagged with "1" go to 1st new column, and so on.
Here is an example:
There are n original columns. Each one of those columns has a key (bottom left), and according to that key it must be added to column 1, 2, 3, or 4 of the new table (bottom right). This is all nice and clean but the real spreadsheet has perhaps 270+ columns and they must be condensed into 10 columns or so for 3000+ ID's where not all ID's have all columns filled.
I am not sure how to create that sort of loop, I thought of looping through the key first, then finding in the original columns each "A", adding them to first column of new table, then doing that through all of them, but I'm not sure how to avoid overwriting old sums with the new ones.
Cheers!
You can do it with SUMPRODUCT. Actually, you can code it on VBA using this same formula of SUMPRODUCT and pasting values or with Evaluate:
=SUMPRODUCT(--($A$2:$A$6=$F14)*$B$2:$M$6*TRANSPOSE(--($B$14:$B$25=G$13)))
Depending on your Excel version maybe you need to input the formula as array formula, so instead of normally, type the formula and press CTRL+ENTER+SHIFT
UPDATE: You can also do it with VBA but you need to make some changes to your source file to make it work with any dataset of any size:
Your data must be alone in a worksheet called DATA
Your keys must be alone in a worksheet called KEYS
The code will generate a new worksheet with the grouped data according to keys. It uses same formula than before, but does it everything alone.
Sub TEST()
Dim wk As Worksheet
Dim rngData As Range
Dim rngKeys As Range
Dim LR As Long 'last non blank row
Dim LC As Long 'last non blank column
Dim ThisKeys As Variant
Set wk = ThisWorkbook.Sheets.Add(, ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)) 'add new worksheet for output at end of workbook
With ThisWorkbook.Worksheets("DATA")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rngData = .Range(.Cells(2, 2), .Cells(LR, LC))
.Range("A2:A" & LR).Copy wk.Range("A2:A" & LR) 'copy names to output
End With
With ThisWorkbook.Worksheets("KEYS")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
Set rngKeys = .Range("B2:B" & LR)
.Range("B2:B" & LR).Copy
wk.Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End With
With wk
.Range("B2:B" & LR).RemoveDuplicates Columns:=1, Header:=xlNo
LR = .Range("B" & .Rows.Count).End(xlUp).Row
ThisKeys = .Range("B2:B" & LR).Value
.Range("B2:B" & LR).Clear
.Range("B1").Resize(1, UBound(ThisKeys)) = Application.WorksheetFunction.Transpose(ThisKeys) 'transpose keys to horizontal
.Range("A1").Value = "Names / Keys"
LR = .Range("A" & .Rows.Count).End(xlUp).Row
LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Range("B2").FormulaArray = _
"=SUMPRODUCT(--(DATA!R2C1:R" & rngData.Rows.Count + 1 & "C1=RC1)*DATA!" & rngData.Address(True, True, xlR1C1) & "*TRANSPOSE(--(KEYS!R2C2:R" & rngKeys.Rows.Count + 1 & "C2=R1C)))"
.Range("B2").AutoFill Destination:=Range(.Range(.Cells(2, 2), .Cells(2, LC)).Address), Type:=xlFillDefault 'drag to right
.Range(.Cells(2, 2), .Cells(2, LC)).AutoFill Destination:=Range(.Range(.Cells(2, 2), .Cells(LR, LC)).Address), Type:=xlFillDefault 'drag to right
.Range(.Cells(2, 2), .Cells(LR, LC)).Value = .Range(.Cells(2, 2), .Cells(LR, LC)).Value 'paste as values, not formulas
End With
Erase ThisKeys
Set rngKeys = Nothing
Set rngData = Nothing
Set wk = Nothing
End Sub
I uploaded the file with the code so you can check it out: https://drive.google.com/file/d/1rc8oOPcqP4HBFEyamku24H9hHRFpncq_/view?usp=sharing
I need to find the value of the last cell in column b of sheet1. This value will change weekly. I then want to take that value and find it in sheet2. Then I want to copy and paste all data below this found value to sheet3. I can't get past the first part with the following code:
Dim cell As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Set cell = Range("B:B").Find("rangefound")
rangefound = lastRow = Cells(lastRow, 2).Value
I've been struggling with the syntax for a month and really don't know what I'm doing.
try this
Sub test()
Dim cell As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
rangefound = Sheet1.Cells(lastRow, 2).Value
Set cell = Sheet2.Range("B:B").Find(rangefound)
MsgBox "The value was found in Sheet2!" & cell.Address
End Sub
The issues with your code were
using rangefound before it had a value, i.e. the order of the commands
using "rangefound" as a text instead of the variable
wrong syntax to assign a value to rangefound
not qualifying which sheet should be searched
Edit: To extend the code to copy the data below the found value to another sheet, use Offset to reference one row below. There are many different ways to do this, so using Offset is just one option.
Here is the complete code
Sub test()
Dim mycell As Range, RangeToCopy As Range
Dim rangefound As Integer
Dim lastRow As Long
lastRow = Sheet1.Range("B" & Rows.Count).End(xlUp).Row
rangefound = Sheet1.Cells(lastRow, 2).Value
' this is the cell with the found value
Set mycell = Sheet2.Range("B:B").Find(rangefound)
' now find the last row in Sheet2. We can use lastRow again,
' since it is no longer needed elsewhere
lastRow = Sheet2.Range("B" & Rows.Count).End(xlUp).Row
' set the range to copy to start one cell below rangefound
' to the end of the data in column B
Set RangeToCopy = Sheet2.Range(cell.Offset(1, 0), Sheet2.Cells(lastRow, "B"))
' copy the range and paste into Sheet3, starting at A1
RangeToCopy.Copy Sheet3.Range("A1")
End Sub
Note: I changed the variable name from "cell" to "mycell". It's better to use variable names that cannot be mistaken for Excel artifacts.
Another edit: If you need to paste into the next free row in Sheet3, use the techniques already established.
[...]
Set RangeToCopy = Sheet2.Range(cell.Offset(1, 0), Sheet2.Cells(lastRow, "B"))
' get the next available row in Sheet3
lastRow = Sheet3.Range("A" & Rows.Count).End(xlUp).Row + 1
' copy and paste
RangeToCopy.Copy Sheet3.Range("A" & lastRow)
[...]
Note that I'm using the same variable for three different purposes. If that is too confusing, create three distinct variables instead.
I'm at a loss on this and need some help. I've lurked around at answers and have Frankensteined together some code for a macro but it just isn't working.
Here is part of what I have so far:
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lrow = Lastrow To Firstrow Step -1
With .Cells(lrow, "G")
Range("G1").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
End With
Next lrow
End With
I have a very similar block of code before this that deletes crap from the text files I'm importing and it works perfectly through all the number of rows. When I run the same thing with this formula, it only puts the formula in G1 and doesn't cycle through the rest of the sheet. I've tried this and it works, but copies down through all million plus rows:
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
Selection.AutoFill Destination:=Range("G:G")
I've tried this and then run the same code that gets rid of the text file crap but I get an error "End If without block If".
To fill the formula in one cell at a time you need to cycle through them; don't keep relying on the ActiveCell property.
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lrow = Lastrow To Firstrow Step -1
.Cells(lrow, "G").FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
Next lrow
End With
But you can speed things up by putting the formula into all of the cells at once.
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range(.Cells(Firstrow, "G"), .Cells(Lastrow, "G"))
.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
End With
End With
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
Another version, to dynamically select the columns based on their titles. Comments included.
Dim row As Range
Dim cell As Range
Static value As Integer
'Set row numbers
'Find the starting row. Located using Title of column "Start" plus whatever number of rows.
Dim RowStart As Long
Set FindRow = Range("A:A").Find(What:="Start", LookIn:=xlValues)
RowStart = FindRow.row + 1
'End of the range. Located using a "finished" cell
Dim RowFinish As Long
Set FindRow = Range("A:A").Find(What:="Finished", LookIn:=xlValues)
RowFinish = FindRow.row - 1
'Set range - Goes Cells(Rownumber, Columnnumber)
'Simply ammend RowStart and RowFinish to change which rows you want.
' In your case you need to change the second column number to paste in horizontally.
Set rng = Range(Cells(RowStart, 1), Cells(RowFinish, 1))
'Start the counter from the starting row.
value = RowStart
For Each row In rng.Rows
For Each cell In row.Cells
'Insert relevant formula into each cell in range.
cell.Formula = _
"=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
'Increment row variable.
value = value + 1
Next cell
Next row
I am trying to create a variable with all the cell values in used columns in Row 1.
Dim vaData As Variant
With wsSheet
vaData = .Range("B1:" & .Range(.Columns.Count & "1").End(xlRight).Column).Value
End With
I am getting a range failed error.
I have successfully done this for getting values in a column, BK.
vaData = .Range(.Range("BK2"), .Range("BK100").End(xlUp)).Value
Try this:
Dim vaData As Variant
With wsSheet
vaData = .Range("B1", .Cells(1, .Columns.Count).End(xlToLeft))
End With
The thing is you might have been confused between Range Object and Cells Property.
Refer to below Range Object Syntax I frequently use:
Range("Cell1", "Cell2") e.g. Range("A1", "A10")
Range("Cell1:Cell2") e.g. Range("A1:A10")
Range(Cells(1),Cells(2)) e.g. Range(Cells(1, 1), Cells(10, 1))
Above all evaluates to Range A1:A10. Now how to make it dynamic?
Examples:
Dynamic Last Row
With Sheet1
.Range("A1", .Range("A" & .Rows.Count).End(xlUp)) '~~> dynamic last row
.Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row) '~~> same as above
.Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) '~~> same as above
End With
Dynamic Last Column
With Sheet1
.Range("A1", .Cells(1, .Columns.Count).End(xlToLeft)) '~~> same as my answer
.Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft)) '~~> same as above
End With
Btw, another more complex approach is found here using Find Method.
The same approach was used here to find the last column.
Also you might want to check different ways on using Cells Property.
My first guess is that in the first example you are missing the column letter i.e. the formula will evaluate to something like
vaData =.Range("B1:10").Value 'Error!
Instead of
vaData =.Range("B1:B10").Value 'Ok!
Hope this helps...