I am trying to match a value from a cell (grid_2.range "A1") and grid_2.range("B1") with a column P on a sheet named grid_2 ("Grid2") to copy all the row where there value is located. Therefore, I will need to check on my data and copy/paste the entire row to another sheet maned grid. But for some reason my code loops but only find the match and copy and paste once.
Sub new_copyPaste()
Dim targetSh As Worksheet
Dim i As Variant
Dim lastRow As Long
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
Position = WorksheetFunction.Match(grid_2.Range("A1"), Worksheets("Grid2").Columns(16), 0)
If grid_2.Cells(i, 16).Value = grid_2.Range("A1") Then
Worksheets("Grid2").Rows(Position).Copy
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
Position = WorksheetFunction.Match(grid_2.Range("B1"), Worksheets("Grid2").Columns(16), 0)
If grid_2.Cells(i, 16).Value = grid_2.Range("B1") Then
Worksheets("Grid2").Rows(Position).Copy
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
End Sub
Maybe do you know what I am doing wrong?
I thought about using VLookup, but after researching, it seems that function match would be more appropriate.
I am open for suggestions :)
Match only returns the first match and is not needed here:
Sub new_copyPaste()
Dim lastRow As Long
Dim i As Long
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
If grid_2.Cells(i, 16).Value = grid_2.Range("A1") Then
Worksheets("Grid2").Rows(i).Copy
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
For i = 3 To grid_2.Cells(Rows.Count, "P").End(xlUp).Row
If grid_2.Cells(i, 16).Value = grid_2.Range("B1") Then
Worksheets("Grid2").Rows(i).Copy
lastRow = grid.Cells(Rows.Count, "C").End(xlUp).Row + 1
grid.Range("A" & lastRow).PasteSpecial
End If
Next i
End Sub
Related
I have excel with 5 different sheets.
sheet3 and sheet4 i want delete rows based on the single column cell value.
in sheet 3 i want to delete rows based on H column cell values if H2="#N/A" and H503="#N/A" then delete entire rows.
in sheet 4 i want to delete rows based on b column cell values if B2="320857876",B3="32085678",B4="12133435" the delete the entire rows where B column cell values starts with 302.
and i want to delete all Data from 'C' column
My excel sheet is like this
Using excel file
Sub Create()
Dim LastRow As Long
Dim i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i) = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
You've got a few requirements there and your code is fairly light but regarding the #N/A part of it, you can't just test for that text using the value approach, which is the default property returned for a range object.
Sub Create()
Dim LastRow As Long, i As Long
LastRow = Range("B10000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("B" & i).Text = "#N/A" Then
Range("B" & i).EntireRow.Delete
End If
Next
End Sub
... you need to use .Text to get that to work, or, If IsError(Range("B" & i)) Then is another approach.
The rest of your requirements is just logic. The rest of your code is relatively sound so you just need to work through it.
I hope that helps.
Sub delete_rows()
Dim sheet As Worksheet, cell As Range
Count = 1
For Each sheet In ThisWorkbook.Worksheets
If Count = 3 Then
lastrow = sheet.Cells(sheet.Rows.Count, "H").End(xlUp).Row
Set Rng = sheet.Range("H1:H" & lastrow)
For i = Rng.Cells.Count To 1 Step -1
If Application.WorksheetFunction.IsNA(Rng(i).Value) Then
Rng(i).EntireRow.Delete
ElseIf Rng(i).Value = "#NA" Then
Rng(i).EntireRow.Delete
End If
Next
ElseIf Count = 4 Then
lastrow = sheet.Cells(sheet.Rows.Count, "B").End(xlUp).Row
Set Rng = sheet.Range("B1:B" & lastrow)
Debug.Print (Rng(4).Text)
If Rng(2).Value = "320857876" And Rng(3).Value = "32085678" And Rng(4).Value = "12133435" Then
For i = Rng.Cells.Count To 1 Step -1
If Left(Rng(i).Value, 3) = "302" Then
Rng(i).EntireRow.Delete
End If
Next
End If
lastrow = sheet.Cells(sheet.Rows.Count, "C").End(xlUp).Row
Set Rng = sheet.Range("C1:C" & lastrow)
For Each cell In Rng
cell.Value = ""
Next cell
End If
Count = Count + 1
Next
End Sub
I am trying to add vlookup formulas to multiple columns (E:I) when the corresponding cell in column "D" is blank. For example when cell D113 and down are blank, I want to add "=VLOOKUP(A2,Sheet4!$A:$L,5,False)" to cells E113:and down and then repeat for colums G,H,I,etc.
But the code I have now as shown below adds the vlookup to all cells in column E & lastrow, overwriting existing data above E113. Code is as follows:
Sub PrevInactives()
Dim ws As Worksheet
Dim lastrow As Long
lastrow = Range("A2").End(xlDown).Row
For Each Cell In Sheets(1).Range("D2:D" & lastrow)
Select Case Cell.Value
Case ""
If Cell.Offset(1, 0) = "" Then
Range("E2:E" & lastrow).Formula = "=VLOOKUP(A2,Sheet3!$A:$L,5,FALSE)"
End If
End Select
Next Cell
End Sub
Does anyone have a solution for my dilemma?
Thanks,
Jason
EDIT, 9/26/17: Below is the updated code I added in, but when I run this macro, nothing happens.
Sub PrevInactives()
Dim r As Long
For r = 2 To lastrow
lastrow = Range("A2").End(xlDown).Row
If IsEmpty(Cells(r, 4).Value) And Not IsEmpty(Cells(r - 1, 4).Value) Then
Range(Cells(r, 5), Cells(r, 9)).Formula = "=VLOOKUP($A2" & r & ",Sheet4!$A:$L,False)"
End If
Next r
End Sub
If I'm understanding correctly, you want to have inside of your loop something such as:
If IsEmpty(Cells(r,4).Value) AND Not IsEmpty(Cells(r-1,4).Value) Then
'Insert vlookup stuffs
End If
Rather than using For Each as the loop, you can loop For r = 2 to LR using the above example:
Dim r as Long
For r = 2 to lastrow
If IsEmpty(Cells(r,4).Value) AND Not IsEmpty(Cells(r-1,4).Value) Then
Range(Cells(r,5),Cells(r,9)).Formula= "=VLOOKUP($A" & r & ",Sheet3!$A:$L,5,FALSE)"
End If
Next r
Essentially, the issue is that you are using:
Range("E2:E" & lastrow).Formula = "=VLOOKUP(A2,Sheet3!$A:$L,5,FALSE)"
When you want Cell.Formula = ""; you are adding the formula to all of those cells if the case is ever true.
Edit, 20170926:
Fixing your code:
Sub PrevInactives()
Dim r As Long, lastrow as Long
lastrow = Range("A2").End(xlDown).Row 'Need to define before looping
'You could use lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lastrow
If IsEmpty(Cells(r, 4).Value) And Not IsEmpty(Cells(r - 1, 4).Value) Then
Range(Cells(r, 5), Cells(r, 9)).Formula = "=VLOOKUP($A" & r & ",Sheet4!$A:$L,False)" 'You had in A2&r, so it would be A22, A23, ..., A2&LR
End If
Next r
End Sub
I pasted the entire macro below but this is the important part.
Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value
Range("D2:D10000").Value = Range("D2").Offset(-1, 1).Value
Range("F2:F10000").Value = Range("F2").Offset(-1, 1).Value
Range("H2:H10000").Value = Range("H2").Offset(-1, 1).Value
It works as is except it is creating unnecessary data because I don't know how to use variable names in a range object. My ranges are currently hard coded such as ("A1:A1000"), when I would like it to be something like ("A1:A & LastRow).
Also I have to explicitly call out column names to copy because the range won't accept a variable name like ("currentColumn & 1:currentColumn & LastRow).
Is there a way to use a varible name as part of a range object so we can use them in loops?
Sub prepareWorkbook()
Dim wbk As Workbook
Set wbk = ThisWorkbook
Dim wks As Worksheet
Set wks = wbk.ActiveSheet
Dim colx As Long
Dim ColumnCount As Long
Dim MySheetName As String
MySheetName = "Import"
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
ActiveSheet.Name = MySheetName
'identify the Id column and move it to 1st column
Dim answer As Variant
Dim IdColumn As Range
answer = Application.InputBox("Enter Letter of Id column")
If Columns(answer).Column = 1 Then
Else
'cut Id column from current location and insert it at column index 1
Columns(answer).Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
End If
'trim the PartNumber column of any trailing spaces
Dim c As Range
For Each c In Range("A1:A10000")
c.Value = Application.Trim(Replace(c.Value, Chr(160), Chr(32)))
Next
' insert column every other column
' Loop through number of columns.
ColumnCount = Application.WorksheetFunction.CountA(Rows(1)) * 2
'step 2 means skip every other
For colx = 2 To ColumnCount Step 2
Columns(colx).Insert Shift:=xlToRight
Next
Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value
Range("D2:D10000").Value = Range("D2").Offset(-1, 1).Value
Range("F2:F10000").Value = Range("F2").Offset(-1, 1).Value
Range("H2:H10000").Value = Range("H2").Offset(-1, 1).Value
wks.Cells.EntireColumn.AutoFit
MsgBox ("Done")
End Sub
Assuming the you are running code in the Worksheet added here:
'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
ActiveSheet.Name = MySheetName
Also not sure what is the purpose of this code, nevertheless using it for the sample
Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value
Try this:
Dim lLastRow As Long
lLastRow = wbk.Worksheets(MySheetName).UsedRange.SpecialCells(xlLastCell).Row
Rem This updates only columns B, D, F & H - adjust as needed
For colx = 2 To 8 Step 2
With wbk.Worksheets(MySheetName)
Rem Creates Range as Range(Cells(rIni,cIini), Cells(rEnd,cEnd))
rem Corresponding code for "Range("B2:B10000").Value = Range("B2").Offset(-1, 1).Value" (see comment above)
Range(.Cells(2, colx), .Cells(lLastRow, colx)) = .Cells(2, colx).Offset(-1, 1).Value
End With: Next
Something like:
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("B2:B" & LastRow).Value = Range("B2").Offset(-1, 1).Value
Range("D2:D" & LastRow).Value = Range("D2").Offset(-1, 1).Value
Range("F2:F" & LastRow).Value = Range("F2").Offset(-1, 1).Value
Range("H2:H" & LastRow).Value = Range("H2").Offset(-1, 1).Value
Although this answer won't be applied to your situation, I feel like this could help answer some questions you have in there.
When specifying a range, you can separate the column (letter) and row (number) and use your own variables.
In a for loop, this could look like
for i = 1 to 100
Range("A" & i).Value = Range("A"&i).Offset(, 1).Value
next
You can also determine the number of the row of the selected cell using:
dim RowNb as long
RowNb = (ActiveCell.Row)
This also applies to columns, and can be used in a loop like I mentionned at the start.
The one thing that was conspicuous by its absence in your description was any mention of the nature of the data in the worksheet. You mentioned A1 briefly but your range value assignments started at row 2 so it may be inferred that row 1 contains column header labels.
Sub prepareWorkbook()
Dim wbk As Workbook, wks As Worksheet
Dim colx As Long
Dim lc As Long, lr As Long
Dim MySheetName As String
Set wbk = ThisWorkbook 'no idea what this does
Set wks = wbk.ActiveSheet 'no idea what this does
MySheetName = "Import"
'no idea what this does or what sht is
'LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'copy the worksheet and rename it before editing
Sheets(1).Copy After:=Sheets(1)
With Sheets(2)
.Name = MySheetName
If CBool(Application.CountIf(.Rows(1), "PartNumber")) Then
colx = Application.Match("PartNumber", .Rows(1), 0)
Else
colx = .Range(Application.InputBox("Enter Letter of Id column") & 1).Column
End If
If .Columns(colx).Column > 1 Then
'cut Id column from current location and insert it at column index 1
.Columns(colx).Cut
.Columns(1).Insert Shift:=xlToRight
End If
'quickest way to trim trailing spaces is with Text-to-Columns, Fixed Width
With .Columns(1)
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, FieldInfo:=Array(0, 1)
End With
' insert column every other column (working backwards toward A1)
For lc = .Cells(1, Columns.Count).End(xlToLeft).Column To 2 Step -1
.Columns(lc).Insert Shift:=xlToRight
Next lc
For lc = (.Cells(1, Columns.Count).End(xlToLeft).Column - 1) To 2 Step -2
'let's put the row-by-row value in instead of a single value into all cells
lr = .Cells(Rows.Count, lc + 1).End(xlUp).Row
With .Cells(2, lc).Resize(lr - 1, 1)
.Cells = .Offset(-1, 1).Value
.EntireColumn.AutoFit
End With
Next lc
End With
Set wbk = Nothing
Set wks = Nothing
End Sub
Explanations as comments in code.
I did a search before posting this question. The results that I found are only finding the last row of 1 column, I would like to find the last row of 2 columns then enter the data accordingly. Hope you guys could help. Thanks! :)
If optMemberName.Value = True Then
With Sheets("Sheet1")
Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row) = txtMemberName.Text
End With
ElseIf optMemberID.Value = True Then
With Sheets("Sheet1")
Range("B" & .Cells(.Rows.Count, "B").End(xlUp).Row) = txtMemberID.Text
End With
End If
This is the output now
This is how the userform looks like
This is the output that I want
You were pretty close to the solution. ;) Try this:
Private Sub CommandButton1_Click()
Dim rA As Long, rB As Long
Dim lastRow As Long
rA = Cells(Rows.Count, 1).End(xlUp).Row ' returns last row of first column
rB = Cells(Rows.Count, 2).End(xlUp).Row ' returns last row of second column
lastRow = IIf(rA > rB, rA + 1, rB + 1) ' returns maximum of rA and rA plus one
If optMemberName.Value = True Then
Cells(lastRow, 1) = txtMemberName.Text
ElseIf optMemberID.Value = True Then
Cells(lastRow, 2) = txtMemberID.Text
End If
End Sub
Hi guys I am running a macro in Excel 2003 to match property addresses to their owners addresses so I end up with a report of absentee owners.
So in:
column A column C
10 Smith DR Smithville 10 Smith DVE, Smithfield, 49089 Antartica
This is how some of the raw data has been input but I need for this record and all the other slightly different records to be a match and therefore not selected by the macro
as it searches for absentee owners addresses then populates the selected records to sheet2.
In laymans terms if I could compare say only the first 6 characters in column A to the first 6 characters in column C then I think it would work the way I need it to.
Does anyone know how I can achieve this within my macro shown below
Sub test()
Dim i As Long, lr As Long, r As Long, ws As Worksheet, value As Variant,
val As Variant
Dim sval As Integer, lr2 As Long
Application.ScreenUpdating = False
Set ws = Worksheets("Sheet1")
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lr
value = Split(Cells(i, 1).value, ", ")
For val = LBound(value) To UBound(value)
sval = InStr(1, Cells(i, 3).value, value(val), 1)
If sval = 0 Then Range("A" & i & ":" & "C" & i).Interior.Color = 65535
Next
Next
For r = 2 To lr
lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
If Range("A" & r).Interior.Color = 65535 Then
Rows(r).Copy Destination:=Sheets("Sheet2").Rows(lr2 + 1)
lr2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next r
Sheets("Sheet2").Cells.Interior.ColorIndex = 0
Application.ScreenUpdating = True
MsgBox "Done Macro"
End Sub
Hopefully I have pasted the code in the correct format required here.
So any help and guidance would be much appreciated.
You can use the formula LEFT(). This will check the first 6 characters from the cell in column A to the first 6 characters in column C. If there's a match, it will add the value from column A to the next free cell in column A, Sheet2.
Sub First6Characters()
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastRowSheet2 = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Left(Range("A" & i), 6) = Left(Range("C" & i), 6) Then
Sheets("Sheet2").Range("A" & LastRowSheet2).Value = Range("A" & i).Value
LastRowSheet2 = LastRowSheet2 + 1
End If
Next i
End Sub
Source: http://www.techonthenet.com/excel/formulas/left.php