I am trying to insert the date using the Today Function in Excel. I have a sheet with the date at the top, in Cell I2.
I have a table and am using VBA to copy paste values into it - this will be used daily and I want the date to be auto populated into Column D, starting from the last used row in Column D and ending with the last used row in Column C. I then want the date to be saved as value.
I tried using the following code but it didn't work - nothing happened.
Can someone please help me understand why, and how to correct this?
With ThisWorkbook
With .Sheets("Test")
Dim rng As Range
Set rng = .Range(.Cells(.Rows.Count, "D").End(xlUp), .Cells(.Rows.Count, "C").End(xlUp).Offset(0, 1))
rng.Value = ThisWorkbook.Sheets("Test").Range("I2").Value
End With
End With
I believe this is what you want:
Find the last used row with Column C (Assumes the last row in C & D are equal so just calculate this in one column. It looks like you are trying to over-complicate)
Skip the temp rng assignment and apply the value transfer using a combination of Offset when calculating lr and Resize when referencing the target row
Sub Try_Me()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Test")
Dim lr As Long
lr = ws.Range("C" & ws.Rows.Count).End(xlUp).Offset(1).Row
ws.Range("C" & lr).Resize(1, 2).Value = ws.Range("I2").Value
End Sub
Looking at your current Set rng = ... statement it looks like you may be trying to determine the last used row in either column indicating that the last used row in both may vary. If that is the case, you can compare both and pick the max like so:
Sub Try_Me()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet2")
Dim c As Long, d As Long, lr As Long
c = ws.Range("C" & ws.Rows.Count).End(xlUp).Offset(1).Row
d = ws.Range("C" & ws.Rows.Count).End(xlUp).Offset(1).Row
lr = Application.WorksheetFunction.Max(c, d)
ws.Range("C" & lr).Resize(1, 2).Value = ws.Range("I2").Value
End Sub
Related
Attempting to write some vba but not having much luck. I have column A with a whole list of values that I am counting and looping through. For Each value in column A, there can be a match in range C:D. If a value in column A matches a value in column C. I want to insert the corresponding value in column D below the Column A value. I am not too certain on what my IF then statement should look like. I have my counter and loop... I am just unsure where to go with the middle portion of the code.
Sub SetListOrder()
Dim wp As Worksheet
Dim ef As Long
Set wp = Workbooks("Packing Slip FIXED").Worksheets("Locate Order")
ef = wp.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To ef
IF (UNSURE WHAT TO PLACE HERE!) THEN
Next i:
End Sub
Edit: adding sample data
Sample Data screenshot
In this example, I would like to insert a new row under the value in "A" where A=C. ie. Range in column "A" = Range in Column "C". I would like to then insert the value from "D". The new order in rows 4-6 would be:
Range
Order Group 1
2604291
I already have written the code to manually move my sheets around to follow the specific order once I am able to get the names in said order.
I agree with #BigBen that the simpler approach would be to insert a formula in column D that only replicates the column A value when a match is detected. Such a formula would probably look like the following -
=IF($A1=$C1,$A1,"")
This would be copied into cell D2 of your column and copied down as far as needed.
However, if you did want to achieve this with VBA and I have noted you used the word insert a value (as opposed to simple enter a value or copy & paste a value) then this could be your approach -
Sub SetListOrder()
Dim wp As Worksheet
Dim ef As Long
Dim i As Long
Set wp = Workbooks("Packing Slip FIXED").Worksheets("Locate Order")
ef = wp.Range("A" & Rows.Count).End(xlUp).Row
For i = ef To 1 Step -1
If wp.Range("A" & i).Value = wp.Range("C" & i).Value Then
wp.Range("D" & (i + 1)).Insert xlShiftDown
wp.Range("D" & (i + 1)).Value = wp.Range("A" & i).Value
Else
End If
Next i
End Sub
This approaches the problem in reverse by going up your column instead of going down. Note that by inserting your data, will cause each previous value to move down as well. If you don't want this, then simply erase the .Insert line and it will enter the value instead of inserting a cell.
Modify the below code and use:
Formula:
=IFNA(VLOOKUP(A1,$C$1:$D$5,2,0),"Missing")
VBA Code:
Option Explicit
Sub test()
Dim rngSearch As Range, rngFound As Range
Dim LastRowA As Long, LastRowC As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRowA = .Cells(.Rows.Count, "A").End(xlUp).Row
LastRowC = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rngSearch = .Range("C1:D" & LastRowC)
For i = 1 To LastRowA
Set rngFound = rngSearch.Find(.Range("A" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
If Not rngFound Is Nothing Then
.Range("B" & i).Value = .Range("D" & rngFound.Row).Value
Else
.Range("B" & i).Value = "Missing"
End If
Next i
End With
End Sub
Result:
I am quite new to VBA so my question may sound silly to some of you.
I have a problem with my code. I am trying to check between 2 sheets(1st: test and 2nd: test data. In the code I am using the code name of the sheets) how may times a criteria/my product is met and based on that number to add that many rows beneath the SKU/product.
What I want to do is, if for my first product/SKU I have stock in 5 different locations, I want to add 5 rows in the first sheet and to see the qty in column D and the location in column E.
TestData tab
The reason why I need to list the quantity in different cells is that the stock is in different locations, so I can not just add in to one cell.
I am also adding screen shots of how my two sheets look like.
I have not add the loop to find the location yet, but I want to understand how to add the rows first.
Sub test()
Dim myrange As Range, testrange As Range, cell As Range, result As Range
Dim i As Long, testlastrow As Long, lastrow As Long
Dim helprng As Range
lastrow = TESTTAB.Range("a" & Rows.Count).End(xlUp).row
testlastrow = TDATA.Range("a" & Rows.Count).End(xlUp).row
Set testrange = TDATA.Range("a2:c" & testlastrow)
Set myrange = TESTTAB.Range("b2:b" & lastrow)
Set result = TESTTAB.Range("d2:e" & testlastrow)
Set helprng = TESTTAB.Range("f2:f" & lastrow)
For Each cell In myrange
For i = 1 To lastrow
If cell.Cells(i, 1) = testrange.Cells(i, 1) Then
result.Cells(i, 1) = testrange.Cells(i, 2)
End If
Next i
Next cell
End Sub
Here is the raw structure you were asking for.
Sub test()
' 011
Dim Rng As Range
Dim Tmp As Variant
Dim Radd As Long ' number of rows to add
Dim R As Long ' row counter
With Tdata
' Range, Cells and Rows Count, all in the same sheet
' exclude caption row(s)
Set Rng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
Application.ScreenUpdating = False ' speed up the process
With TestTab
' end the loop in row 2 because row 1 might contain captions
' loop bottom to top because row numbers will change
' below the current row as you insert rwos
' column 1 = "A"
For R = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
Tmp = .Cells(R, 1).Value
Radd = Application.CountIf(Rng, Tmp)
If Radd > 1 Then
.Range(.Rows(R + 1), .Rows(R + Radd)).Insert
.Cells(R + 1, 1).Value = Radd ' for testing purposes
End If
Next R
End With
Application.ScreenUpdating = True ' now you look
End Sub
As our Evil Blue Monkey has suggested, inserting blank rows and then populating them may not be the most efficient way. You can copy a row and then click Insert to insert the copied data into a new row. Get the syntax from the Macro recorder if it's of interest. It works with the Range object the same way.
im hoping that someone can help me to take a macro down an entire column.here is what i am trying to do.
the following table is in a worksheet called barcode. it is my master list. column E:E, is a helper column that has part numbers with countif numbers attach like so=:1,:2,:3, etc. i did this because i have multiple orders for part numbers that are due on different dates in the order report. in column c, there is a number of how many of a part has been ran. in column d, the number of parts that have been scrapped and would have to be ran again. i have highlighted a row to use as an example. in this case. part number ms-100 has a total of 1 part ran and zero scrapped.
the next sheet is my order report sheet. it displays what a customer has ordered of what part. the calculation that i want to have is: if ms-100:1 on the order report matches what is on the master list, then take the qty from the order report and subtract how many were ran, and add how many were scrapped. so for this case. if ms-100:1 =ms-100:1 then cell f8 =12-1+0.
my current code will do that, but it will only do the cells that i point them to and not the entire column. to make it easier to see if this code works or not, instead of changing the values of column f on the order report, i moved it to column l. the goal is to have the value change in f, but for now i was putting the value in l. as you can see, in L7, it says no order. i hope this clarifies what i am trying to accomplish. thank you very much. here is the code that i have so far. i was attempting to use for each cell but it doesnt seem to be working.
Sub FIND_MATCHES()
Dim sh1 As Worksheet
Dim sh4 As Worksheet
Set sh1 = ActiveWorkbook.Sheets("BARCODE")
Set sh4 = ActiveWorkbook.Sheets("ORDER REPORT")
Dim CELL As Range
Dim LASTROW As Long
Dim R As Long
Dim c As Range
Set c = sh4.Range("L:L")
LASTROW = sh4.CELLS(Rows.COUNT, 12).End(xlDown).Row
'LASTROW = Range("F7:F" & Rows.COUNT).End(xlUp).Row
Dim COMPID As Range
Set COMPID = sh1.Range("E:E").Find(What:=sh4.Range("N7").Value, LookIn:=xlValues, LOOKAT:=xlWhole)
'sh4.Range("L7:L" & LASTROW).Activate
'sh4.Range("L7:L" & LASTROW).Select
For Each CELL In c
If COMPID Is Nothing Then
sh4.Range("L7").Value = "NO ORDER"
Else
'TEST CELL'sh4.Range("L7").Value = COMPID.Offset(, -2).Value
sh4.Range("L7").Value = sh4.Range("F7").Value - COMPID.Offset(0, -2).Value + COMPID.Offset(0, -1).Value
'Range("L7:L" & LASTROW).Select
' Range("L8").Select
Exit For
End If
Next CELL
End Sub
I was able to find the solution myself. the below code is what i used. I thought i would share it just in case someone else had the same issue.
Sub FIND_MATCHES()
Dim barcode As Worksheet
Dim order As Worksheet
Set barcode = ActiveWorkbook.Sheets("BARCODE")
Set order = ActiveWorkbook.Sheets("ORDER REPORT")
Dim LASTROW As Long
Dim c As Long
Dim X As Integer
X = 1
Dim finalrow As String
finalrow = order.cells(Rows.COUNT, 12).End(xlUp).Row
Dim location As Range
Set location = barcode.cells.Item(X, "E")
Dim HELPER As String
Dim NUMROWS As String
NUMROWS = order.cells(Rows.COUNT, 14).End(xlUp).Row
HELPER = barcode.cells.Item(X, "E").Value
LASTROW = order.cells(Rows.COUNT, 14).End(xlUp).Row
Dim ENDROW As String
ENDROW = order.cells(Rows.COUNT, 4).End(xlUp).Row
For X = 1 To ENDROW
For c = 7 To NUMROWS
If order.cells(c, 14).Value = barcode.cells.Item(X, "E").Value Then
order.cells(c, 12).Value = order.cells(c, 6).Value - barcode.cells.Item(X, "E").OFFSET(0, -2).Value + barcode.cells.Item(X, "E").OFFSET(0, -1).Value
Else
ActiveCell.OFFSET(1, 0).Select
End If
Next c
Next X
order.Range("A2").Select
End Sub
Hi this is my first post and i am newbie when it comes to VBA.
So i tried the last 6 hours to accomplish one task.
I already managed to get the code for the For each loop and it works and copies the value to the existing workbook. But i couldnt find out why it always copies the value to A2 and not further to A3/A4/A5 and so on .
I tried these piece of code " range = range + 1 " but i keep getting runtime errors and it still copies the values to A2 and overwrites it when it gets a new value from the loop.
I think its only a litte change needed but i cant figure it out. :(
Sub copie1()
Dim ws As Worksheet
Dim cell As Range
Dim targetsheet As Worksheet
Dim target As Range
Dim rngTemp As Range
Set wkba = ActiveWorkbook
Worksheets("cop1").Activate
LR = Cells(Rows.Count, "A").End(xlUp).Row
LT = Cells(Rows.Count, "X").End(xlUp).Row
Set rngTemp = Range("X2:X" & LT)
Workbooks.Open Filename:="C:\Users\path......."
Set targetsheet = Worksheets("Data")
Set target= targetsheet.Range("A1")
For Each cell In rngTemp
If cell > 0 Then
target.Offset(1, 0) = cell.Value
End If
target = target+1 '// is this right?
Next cell
End Sub
my goal is the loop through column X in a Workbook and copy every single data that is bigger than 0 ( because there are empty cells & cells with value 0)
and paste it in an existing workbook in range A2/A3/A4 and so on
You can't add the number one to a Range object.
Try replacing target = target+1 '// is this right? with:
Set target = target.Offset(1)
Does this resolve the problem?
SibSib1903, I have added below a simple example that you can easily adapt to your own requirements. It looks at all cell values in column A and any numeric value greater than zero is copied to column C starting in row 1. For example, if column A contains 45 rows with data, and only three of these rows have a numeric value greater than zero, these three values will copied in column C in the first three rows.
Public Sub copieTest()
Dim ws As Worksheet, cell As Range, rngX As Range
Dim tmpVal As Variant, counter As Long
Set ws = ThisWorkbook.Worksheets("cop1")
Set rngX = ws.Range("A1:A" & ws.Cells(ws.Rows.count, 1).End(xlUp).Row)
counter = 1
For Each cell In rngX
tmpVal = Val(Trim(cell.Value))
If tmpVal > 0 Then
ws.Range("C" & counter).Value = tmpVal
counter = counter + 1
End If
Next cell
Set rngX = Nothing: Set ws = Nothing
End Sub
I'm begginer in VBA and looking for a solution to check something in a table. I would like to create a function that tells if cells in a certain column (range) is not empty only then if the cell in the title column (range) equals something. I tried with a combination of isempty and vlookup but it didn't work.
I hope the description is clear, anyway I attached a simplified table with the problem. Thank you in advance!
enter image description here
Not sure i have understood your problem 100% but lets begin with what i think i understood, and start with the below:
Sub isitEmpty()
With Sheets("Sheet1")
If IsEmpty(.Range("B1:E2")).Value Then
'do something
Else
'do something
End If
End With
End Sub
What do you want to do if the cell is/isnot empty?
Below code works with following assumptions:
Project Type are listed in Column A starting from Cell A4
A,B,C,D category could vary but will always have headings in Row 3
Project Type for which you want the participation as Y, are listed in a column that appear after the last column with headings A,B,C,D. So as per your image its Column F
Sub Demo()
Dim ws As Worksheet
Dim lRProject As Long, lRMatch As Long, lastColumn As Long, i As Long
Dim rngProject As Range, celPro As Range, rngMatch As Range, celMatch As Range
Set ws = ThisWorkbook.Sheets("Sheet5") 'change to your sheet
With ws
lastColumn = .Cells(3, Columns.count).End(xlToLeft).Column 'gives last column with A,B,C,D
lRProject = .Cells(.Rows.count, "A").End(xlUp).Row 'last row in Column A
lRMatch = .Cells(.Rows.count, lastColumn + 1).End(xlUp).Row 'last row in Column F
Set rngMatch = .Range(.Cells(1, lastColumn + 1), .Cells(lRMatch, lastColumn + 1))
Set rngProject = .Range("A4:A" & lRProject)
For Each celMatch In rngMatch
For Each celPro In rngProject
For i = 2 To lastColumn
If celPro.Value = celMatch Then
If .Cells(celPro.Row, i) = "X" Then
.Cells(celMatch.Row, i) = "Y"
End If
End If
Next i
Next celPro
Next celMatch
End With
End Sub
See image for reference.