I'm quite new with vba and would need your precious help.
I want to copy paste a range after the last row if I can't find a match between column B in sheet "all" and column A in sheet "FY23".
My goal is for it to copy paste the range the number of times there's not a match. So if there's 3 values not found in column B it should copy paste 3 times and with my current code it only copy pastes once...
I also want to add the values that are not found in the second cell of the first row copied, not sure how to do that either.
e.g. i can't find "hello" on column B so it will copy paste my range and add "hello" to the 2nd cell of the first row copied.
Thank you a lot in advance.
Sub copypaste()
Dim all As Worksheet, fy23 As Worksheet
Dim allLastRow As Long, fy23LastRow As Long, x As Long
Dim dataRng As Range
Set all = ThisWorkbook.Worksheets("ALL")
Set fy23 = ThisWorkbook.Worksheets("FY23")
allLastRow = all.Range("B" & Rows.Count).End(xlUp).Row
allLastRow = allLastRow + 3
fy23LastRow = fy23.Range("A" & Rows.Count).End(xlUp).Row
Set dataRng = fy23.Range("A2:A" & fy23LastRow)
For x = 2 To allLastRow
On Error Resume Next
If Not all.Range("B" & x).Value = Application.WorksheetFunction.Vlookup(all.Range("B" & x).Value, dataRng, 1, False) Then
Sheets("ALL").Range("A1:BB22").Copy
Sheets("ALL").Range("A" & allLastRow).PasteSpecial
End If
Next x
End Sub
Related
I want to create a macro that inserts new column with column name (BL & Container) and then concatinates 2 column in newly inserted column.
In this column I named BL & Container is a new column added my macro.
Further I want the macro to concatenate the values present in column H and F macro should find column H and F by column name and concatenate the them in to newly inserted column I.
My codes below
Sub insert_conc()
Dim ColHe As Range
Dim FindCol As Range
Dim con As String
Dim x As Long
Set FindCol = Range("1:1") 'Looks in entire first row.
Set ColHe = FindCol.Find(what:="BL/AWB/PRO", After:=Cells(1, 1))
With ActiveWorkbook.Worksheets("WE")
ColHe.Offset(0, 1).EntireColumn.Insert
ColHe.Offset(0, 1).Value = "WER"
'x = Range("A" & Rows.Count).End(xlUp).Row
con = "=H2&""-""&F2"
ColHe.Resize(x - 1).Formula = con
End With
Application.ScreenUpdating = True
End Sub
[![Error in code][3]][3]
In this code line " con = "=H2&""-""&F2"" please advise how do I update column nameinstead of H2 and F2 macro should find columna H2 and F2 header name and then concatinate the values in newly inserted column I BL & container. Please advise.
Please, use the next adapted code:
Sub insert_conc()
Dim sh As Worksheet, x As Long, ColHe As Range
Dim FindCol As Range, con As String, firstCell As Range
Set sh = Worksheets("LCL")
x = sh.Range("A" & sh.rows.count).End(xlUp).row
Set FindCol = sh.Range("1:1") 'Looks in entire first row.
Set ColHe = FindCol.Find(what:="BL/AWB/PRO", After:=sh.cells(1, 1))
ColHe.Offset(0, 1).EntireColumn.Insert
ColHe.Offset(0, 1).value = "BL & Container"
Set firstCell = ColHe.Offset(1, -2) ' determine the cell to replace F2
con = "=" & ColHe.Offset(1).Address(0, 0) & "&" & firstCell.Address(0, 0)
ColHe.Offset(1, 1).Resize(x - 1).Formula = con
End Sub
It is also good to know that using With ActiveWorkbook.Worksheets("LCL") makes sense only if you use it in the code lines up to End with. And your code did not do that... It should be used before, in order to deal with the appropriate sheet, even if it was not the active one.
What's the most efficient way to search for a partial string in a worksheet?
I'm trying to search for "N " in C4 through the end of column C of the active sheet. If "N " does not appear in the array then I want to close the file. If "N " does appear I want to print a message saying "Force data found"
I know you could use the countif function, sum up the times it appears, and then use if/then to determine action -- but I imagine there's a better way. Thoughts?
My code below does a search for "N " in the worksheet and then deletes the rows where it is not present. Note: I want to include the 3 spaces after the N in the search
Image here:
Sub InspectColumn()
'Define variables
Dim Cell As Range, cRange As Range, LastRow As Long, x As Long
Dim Res As Variant
' Define LastRow as the last row of data based on column C
LastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row
' Sets check range as C1 to the last row of C
Set cRange = Range("C1:C" & LastRow)
' For each cell in the check range, working from the bottom upwards
For x = cRange.Cells.Count To 1 Step -1
' find if 'N ' found in any cell in the row
Res = Evaluate("COUNTIF(" & x & ":" & x & ", ""*N *"")")
' if 'N ' not found delete row
If Res = 0 Then
ActiveSheet.Rows(x).Delete
End If
Next x
End Sub
Something along these lines. I've put in as an answer, but will need some tweaking.
Columns("A:A").AutoFilter Field:=1, Criteria1:="<>*N*"
Columns("A:A").SpecialCells(XlCellType.xlCellTypeVisible).EntireRow.Delete
Columns("A:A").AutoFilter
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
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.
I am trying to create a summary list for people in a downstream application to feed several of my production machines. Each machine is going to have their own tab to request material, and I want all of their requests to be summarized on one tab (called "Core_Cutter_List").
So basically I am trying to create a VBA that will copy over a row from spreadsheet "2" into the next blank line on spreadsheet "Core_Cutter_List". I want it to copy if there is text in column A and column G is blank. I have limited knowledge of VBA. The code that I found was able to only test for one of my criteria which was that column G is blank, but basically it runs through every single cell on my file. Do you know how I can add the other criteria of column A having text in it so that it doesn't look through every cell on my sheet? Thanks for any help!
Sub Test()
'
' Test Macro
'
Sheets("2").Select
For Each Cell In Sheets(1).Range("G:G")
If Cell.Value = "" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Core_Cutting_List").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("2").Select
End If
Next
End Sub
If you need two conditions, then you should write them carefully in the IF statement with And:
Something like If cell.Value = "" And Len(cell.Offset(0,-6)) Then should be workable.
Using Select is a bit not advisable, but it works at the beginning - How to avoid using Select in Excel VBA
The Sub bellow does the following
Determine the last used row in Worksheets("2") based on values in column A
Determine the last used col in Worksheets("2") based on values in row 1
Determine the last used row in Worksheets("Core_Cutter_List") based on values in column A
Loop through all used rows in Worksheets("2")
If the cell in col A is not empty And cell in col G is empty
Copy entire row to next empty row in Worksheets("Core_Cutter_List")
Increment next empty row for Worksheets("Core_Cutter_List")
Loop to the next used row in Worksheets("2")
Option Explicit
Public Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet, ws1r As Range, ws2r As Range
Dim ws1lr As Long, ws1lc As Long, ws2lr As Long, i As Long
Set ws1 = ThisWorkbook.Worksheets("2")
Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List")
ws1lr = ws1.Range("A" & Rows.Count).End(xlUp).Row 'last row in "2"
ws1lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'last col in "2"
ws2lr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1 'last row in "Core_Cutter"
For i = 1 To ws1lr
If Len(ws1.Cells(i, "A")) > 0 And Len(ws1.Cells(i, "G")) = 0 Then
Set ws1r = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, ws1lc))
Set ws2r = ws2.Range(ws2.Cells(ws2lr, 1), ws2.Cells(ws2lr, ws1lc))
ws2r.Value2 = ws1r.Value2
ws2lr = ws2lr + 1
End If
Next i
End Sub
My test file
Worksheets("2")
Worksheets("Core_Cutter_List")