I am trying to make a check in/out system for tools. So far I have a worksheet that has a list of items that are checked out currently. Column A in that worksheet is the item number, Column B is the name, and Column C is the date and time. The macro I am trying to make is that when someone enters an the item number they want to check back IN, the macro will find that number they enter on the "Items Out" sheet, cut the entire row, and paste it to the "checkout History" sheet on the first available row. The cell that the user inputs the number they are checking in is the cell "E3" on the "Interface" worksheet. This is what I have so far.
Sub Checkin()
'
Dim targetSh As Worksheet
Dim i As Long
For i = 1 To Cells(Rows.Count, "F").End(xlUp).Row
If Cells(i, 6).value = Worksheets("Interface").Range("E3") Then
Range(Cells(i, 1), Cells(i, 6)).Copy Worksheets("Items Out").Range("A" & Worksheets("Checkout History").Cells(Rows.Count, "A").End(xlUp).Row + 1)
End If
Next i
End Sub
This doesn't work, I got this code from another post and I tried to change it to match my needs but it did not work and I could use some help here. You don't need to make the entire macro unless you really want to, I just need help finding what will make this macro work for me!
Related
Aplication Defined error Copying a specified column and range including blanks with an embedded button running multiple Macros. I know that all rows will be filled in column A so if I could reference the rest of the Macros to A.end
I've looked Google youtube and here although there is a lot of info on copying and pasting, I cannot find one that works for this running multiple Macros.
Macros 5 & 6 is where I start having problems because these columns have multiple blanks throughout.
Raw data to Copy:
Destination:
Private Sub CommandButton1_Click()
Worksheets("Sheet1").Range("a2", Range("a2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("a2") 'macro1
Worksheets("Sheet1").Range("d2", Range("d2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("b2") 'Macro2
Worksheets("Sheet1").Range("c2", Range("c2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("c2") 'macro3
Worksheets("Sheet1").Range("g2", Range("g2").End(xlDown)).Copy _
Worksheets("Sheet2").Range("d2") 'macro4
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = "<0" Then
Worksheets("Sheet2").Range("i2").Copy 'macro5
If Worksheets("Sheet1").Range("e2", Range("e2").End(xlDown)).Value = ">0" Then
Worksheets("Sheet2").Range("j2").Copy 'macro6
Worksheets("Sheet2").Activate 'macro7
Range.end(xldown) only gets you a contiguous range (effectively it will stop at the first blank cell).
Since you want to include blanks, you might want to instead work from the last row of your worksheet back up to the first non-blank cell encountered in that column (which is a way of getting the last row).
This would mean something like:
' If you are new to With statements (below), any objects within the With block that begin with a . relate to "Sheet1". Saves us typing Sheet1 repeatedly, and makes sense to use it since we access a lot of Sheet1's members like range/cells/rows
With Worksheets("Sheet1")
.Range("a2", .cells(.rows.count, "A").End(xlup)).Copy Worksheets("Sheet2").Range("a2") 'macro1
End with
Untested, written on mobile -- but hope it works or gets you closer to a solution. You would need to copy-paste the above and change the A to B, C, D, E, etc. I wasn't too sure what you're trying to achieve with the "<0" condition in macro 5 and 6.
(It would better if you turned the code into a parameterised Sub and just provide the column letter/number as an argument to the sub, but just depends how new you are to VBA and programming in general -- and for the time being whatever is easier for you to understand/maintain.)
Edit regarding macro 5 and 6
With Worksheets("Sheet1")
Dim cell as range
For each cell in .Range("E2", .Cells(.Rows.Count, "E").End(xlUp))
If cell.Value <= 0 Then 'Get rid of the equal sign if you don't want it in your logic/condition'
Cell.Copy Worksheets("Sheet2").cells(cell.row, "I") 'Macro5
ElseIf cell.value > 0 Then
Cell.Copy Worksheets("Sheet2").cells(cell.row, "J") 'Macro6
End If
Next cell
End With
Worksheets("Sheet2").Activate 'macro7
I am developing a financial model for a bank and come across the below issue which I am not able to resolve in Excel VBA, and would appreciate your help.
I have built a simple macro which essentially does two things: (i) it clears contents in a given range, (ii) it populates the same range with a formula. In a very abbreviated way it looks like the following:
Sub AutoCalculateCashFlows()
Range(D208:L208).ClearContents
Range("L208").FormulaR1C1 = "=+R[-34]C-R[-34]C[-1]"
Range("L208").AutoFill Destination:=Range("E208:L208"), Type:=xlFillDefault
End Sub
My problem is that the range that should be auto populated is dependent on how many cells did the user fill in within the range of E10:L10. Users will start populating this range from right to left, but I don't know how far they will go from column L to the left. The formula that my macro auto populates needs at least two data, ie. at least L10 and K10 should be populated and if the latter is the case then the macro only needs to auto populate L208 with formula, in case J10:L10 is filled out then the macro needs to auto populate the range L208:K208 and so on to the point that in case the full D10:L10 range is filled out then E208:L208 should be populated with formula.
I have thought to resolve this issue via two routes: (i) approaching it as a dynamic range problem in which case I need a vba code to determine the previous to the last cell populated by the user in the range D10:L10 and use the column code of that cell in "Destination:=Range("E208:L208")", or (ii) run a loop which will populate range E208:L208 with formula until the cell in the previous column within range D10:L10 is filled in by the user and stop when it is not.
Hope this makes sense and thanks in advance for the help.
When you need a dynamic range in VBA, you should simply build one. This is probably the easiest method:
Sub TestMe()
Dim colRange As Long
Dim rowRange As Long
Dim rngMain As Range
rowRange = 10
With Worksheets(1)
colRange = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set rngMain = .Range(.Cells(rowRange, colRange), .Cells(100, 200))
MsgBox rngMain.Address
End With
End Sub
It is dynamic, based on the last used column in row 1 of the first Worksheet.
Concerning the second used column in Row 1, one of these 3 would probably do it for you, depending on what exactly do you want:
.Cells(1, 1).End(xlToRight).End(xlToRight).Column
.Cells(1, 1).End(xlToRight).Column
.Cells(1, 1).End(xlToRight).Column + 1
I have data on multiple sheets in a workbook that I want copied all to one sheet in that same workbook. When I run the macro, I would like it to start by deleting the current data in the "iPage Data Export" sheet and then replacing it with data from the other sheets.
I want the process to occur one column at a time since I may not bring over everything. Right now I am trying to learn how to do just one column.
I was able to get it to copy all of the contents of a column from one sheet, but when it moves to the next sheet, it overwrites the existing data. In the end, I only get one sheets worth of data copied.
Here are my 4 problems:
How do I make it clear the data on this sheet before running the routine?
How can I make it start each copy function at the bottom of that row (i.e. after the last cell with a value)? I have tried many of the suggestions on this and other boards without success. I will admit I am not very experienced in this.
How can I make it copy to a particular column (currently it just seems to default to A.
How can I concatenate multiple columns during the paste function? I.e. what if I want it to insert: A2&", "B2 instead of just A2
Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "iPage Data Export" Then
Sht.Select
Range("C:C").Copy
Sheets("iPage Data Export").Select
ActiveSheet.Paste
Else
End If
Next Sht
End Sub
How do I make it clear the data on this sheet before running the routine?
Sht.Cells.ClearContents
How can I make it start each copy function at the bottom of that row (i.e. after the last cell with a value)? I have tried many of the suggestions on this and other boards without success. I will admit I am not very experienced in this.
Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
In detail:
Rows.Count will return the number of rows in the sheet, so in the legacy style *.xls workbooks this would return the number 65,536. Therefore "C" & Rows.Count is the same as C65536
Range("C" & Rows.Count).End(xlUp) is the same as going to C65536 and pressing Ctrl + ↑ - The command End(xlDirection) tells the program to go the last cell in that range. In this case, we would end up at the last cell containing data in column C.
.Offset(1, 0) means that we want to return the range offset by an amount of rows and/or columns. VBA uses RC (Rows Columns) references, so whenever you see something like the Offset() function with two numbers being passed as the arguments, it usually relates to the row, and the column, in that order. In this case, we want the cell that is one row below the last cell we referenced.
All-in-all the phrase Range("C" & Rows.Count).End(xlUp).Offset(1, 0) means go to the last cell in column C, go up until we hit the last cell with data, and then return the cell below that - which will be the next empty cell.
How can I make it copy to a particular column (currently it just seems to default to A.
Range("C:C").Copy Destination:=Sheets("iPage Data Export").Range("A:A")
You can pass the Destination argument in the same line and actually bypass the clipboard (faster and cleaner)
How can I concatenate multiple columns during the paste function? I.e. what if I want it to insert: A2&", "B2 instead of just A2
Lets say you wanted to reference column A, B, and F - just use:
Range("A1, B1, F1").EntireColumn
To summarise, you could streamline your existing code to something like (untested):
Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "iPage Data Export" Then
Sht.Range("C1:C" & Cells(Sht.Rows.Count, 3).End(xlUp).Row).Copy Destination:=Sheets("iPage Data Export").Range("A:A")
End If
Next
End Sub
This should do for the copying:
Sub CombineData()
Dim sheet As Worksheet
For Each sheet In Worksheets
If (sheet.Name <> "iPage Data Export") Then
sheet.Select
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Worksheets("iPage Data Export").Activate
Cells(1, ActiveCell.SpecialCells(xlCellTypeLastCell).Column + 1).Select
ActiveSheet.Paste
End If
Next
End Sub
For the concatenation you need to be more specific - but I guess you should open a new question with a clearer focus if you need specific help on that.
I'm currently building a small project planner in Excel that uses the current date to plot coloured blocks under a date column to depict which stage of the project we are currently at for a particular customer (see image below).
Behind each of the coloured blocks is a drop-down menu populated by a list on another sheet. My aim is to search for the current date in cell A1 ( populated using today() ) within all columns that follow the freezed panes (depicted by the black right hand border). When the current date is found, the value of in each of the coloured blocks should be copied into the corresponding cells so that as the project progresses, a line of coloured blocks are entered for each day (with the relevant text from the drop-down depicting the current stage of that block).
Currently I am using the following formula copied into all cells that follow the freeze:
=IF(F$1 = $A$1,$C2,"")
However, when the current date is changed this merely moves the copied blocks across to the relevant column without maintaining the old values from previous days.
I've also attempted this with a VLOOKUP so that I can enter it into a macro and run if from a button but the layout does not allow for a successful VLOOKUP.
The simplest solution I believe would be to have a button that allows the user to save the current state of the column with a header that matches the current date however it has been some time since I have coded in VBA and do not remember how to do this.
Any ideas? Thanks in advance.
Not sure if this is exactly what you're looking for, but here goes...
Sub ColorCode()
Dim ws As Worksheet
Dim rng As Range
Dim cel As Range
Set ws = ThisWorkbook.Sheets("SheetNameHere")
Set rng = ws.Range("F1:I1")***
For Each cel In rng
If cel.Value = ws.Range("A1").Value Then
ws.Range("C2:C8").Copy
ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteValues
ws.Range(Cells(2, cel.Column), Cells(8, cel.Column)).PasteSpecial Paste:=xlPasteFormats
End If
Next
End Sub
If you add that to a new module, you can assign it to a command button. I haven't had a chance to test it, but it cycles through the dates in the first row to see if they match the date in A1. If they do, it copies over the values and formats from C2:C8(change if you need to) into the rows underneath that date. You may need to change some of the ranges to suit your specific worksheet.
So your requirements seem fairly straightforward to me:
you need the tracker to identify the column with today's date
you need to establish a permanent value for each day as it occurs
you need the color of today's values to be added to the cell, and stay that way even after today's date has passed.
The formula you cite in your question, if copied across all cells, will clearly just provide a value on the column for today's date, and unless you use a circular reference to let it self assess and update its value on today's date, it will not retain information when tomorrow comes.
Your idea for a button would work if you want the user to control the time of update, or you could have code that runs either when the workbook opens or when the worksheet itself is activated (placing it in the appropriate object code under either Private Sub Worksheet_Activate() or Private Sub Workbook_Activate().
I think PermaNoob has a right idea of copying the value of the column and pasting the value (rather than the formlula) into that column, but what is missing is appropriate identification of the column containing today's date and the coloring of those cells (if you don't have some method of coloring them that you did not mention). Something like this might work either attached to a button as you suggest, or to the _Activate event as I suggest. This is untested but should give you an idea of how to approach it:
Sub UpdatePlanner()
'~~>dim variables and set initial values
Dim wb As Workbook
Set wb = Workbooks("NAME or INDEX of YOUR workbook")
Dim ws As Worksheet
Set ws = wb.Worksheets("NAME or INDEX of YOUR sheet")
Dim rngHeader As Range
Set rngHeader = ws.Range("F1", ws.Range("F1").End(xlToRight))
Dim rngDate As Range
Dim rngColumn As Range
Dim rngCell As Range
'~~>loop to find the column with today's date
For Each rngDate In rngHeader
If rngDate.value = ws.Range("A1").value Then
Set rngColumn = ws.Range(rngDate.Address, _
ws.Range(rngDate.Address).Offset(65536, 0).End(xlUp)) 'this assumes
'your column may not have a value in every row
Exit For
End If
Next rngDate
'~~>copy and paste the column values and formats
With rngColumn
.Copy
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
'~~>loop to add the color formatting (since I don't see this in your formula)
For Each rngCell In rngColumn
If rngCell.value = ws.Range(Cells(rngCell.Row, 3)).value Then
rngCell.Interior.Color = _
ws.Range(Cells(rngCell.Row, 3)).Interior.Color
End If
Next rngCell
End Sub
I have been asked to create summary worksheets for excel files that I don't populate. These are 'monthly' excel files with the worksheets 'usually' named as to the week commencing date. I say 'usually' as a spelling mistake might creep in or such that wont allow the sheet names to be predicted in advance of their creation. The worksheet wont be created until the week in question has begun.
What I am trying to do, though struggling with, is create some VBA code to copy a number of cells and ranges from each worksheet to a summary worksheet which will be hidden. The worksheets all follow the same formatting, the main info being: A1 as the weekstart date, O4 to R4 as 4 summary column headers and N5 to N30 as username info. O5 to R30 then has counts in them depending on the data within the worksheet.
I want to create some code that copies the weekstart date (A1) alongside each username that is not blank (N5:N30) and the values after in the corresponding row. As the column headers in O4 to R4 dont change these can stay static on the summary sheet.
Afraid I dont know too much about vba. I guess I would use Worksheets.Count to find the number of worksheets? Was going to modify the code on here but I dont know how to ensure each row of data goes on a new line in the summary worksheet?
use the ozgrid example but make this alteration:
.Range("A1").
to
.Range("A" & l).
then amend your original post with further questions + the actual code you are using.
I have amended ozgrid code with the following which may be more or less relevant to your query. If you can rephrase your query into a more task1, task2 way, it will then be easy to change the below script into something you want.
The below script just work as a module instead of a worksheet event which is easier to control, just create a sub module and copy paste it there then run it or you can also create a button on the worksheet to run, using developper tab and choose form or activex button linked to the macro SplitWs.
Sub SplitWs()
Dim wSheet As Worksheet, ws As Worksheet
Dim i As Long
Set wSheet = ThisWorkbook.Worksheets(1)
i = 1
With wSheet
.Columns(1).ClearContents
.Cells(1, 1) = "INDEX"
.Cells(1, 1).Name = "Index"
End With
For Each ws In Worksheets
If ws.Name <> wSheet.Name Then
i = i + 1
With wSheet
.Range("A1").Name = "Start_" & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
SubAddress:="Index", TextToDisplay:="Back to Index"
End With
wSheet.Hyperlinks.Add Anchor:=wSheet.Cells(i, 1), Address:="", _
SubAddress:="Start_" & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next ws
End Sub
I also change the 'l' variable into 'i' which is easier to read.
Hope it will be of help, else comment with the things to amend.
Pascal
http://multiskillz.tekcities.com