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
Related
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
Below is my source table
Name Sales
---------------------------------
Thomas 100
Jay 200
Thomas 100
Mathew 50
Output I need is as below
Name Sales
---------------------------------
Thomas 200
Jay 200
Mathew 50
Basically, I have 2 columns that can have duplicates and I need to aggregate the second column based on first column.
Current code I have is as below. Its working perfectly fine. It takes around 45 seconds to run for 4500 records. I was wondering if there is a more efficient way to do this... as it seems to be a trivial requirement.
'Combine duplicate rows and sum values
Dim Rng As Range
Dim LngRow As Long, i As Long
LngLastRow = lRow 'The last row is calculated somewhere above...
'Initializing the first row
i = 1
'Looping until blank cell is encountered in first column
While Not Cells(i, 1).Value = ""
'Initializing range object
Set Rng = Cells(i, 1)
'Looping from last row to specified first row
For LngRow = LngLastRow To (i + 1) Step -1
'Checking whether value in the cell is equal to specified cell
If Cells(LngRow, 1).Value = Rng.Value Then
Rng.Offset(0, 1).Value = Rng.Offset(0, 1).Value + Cells(LngRow, 2).Value
Rows(LngRow).Delete
End If
Next LngRow
i = i + 1
Wend
Note that this is part of a larger excel app and hence I definitely need the solution to be in Excel VBA.
Here you go:
Option Explicit
Sub Consolidate()
Dim arrData As Variant
Dim i As Long
Dim Sales As New Scripting.Dictionary 'You will need the library Microsoft Scripting Runtime
Application.ScreenUpdating = False 'speed up the code since excel won't show you what is happening
'First of all, working on arrays always speeds up a lot the code because you are working on memory
'instead of working with the sheets
With ThisWorkbook.Sheets("YourSheet") 'change this
i = .Cells(.Rows.Count, 1).End(xlUp).Row 'last row on column A
arrData = .Range("A2", .Cells(i, 2)).Value 'here im assuming your row 1 has headers and we are storing the data into an array
End With
'Then we create a dictionary with the data
For i = 1 To UBound(arrData) 'from row 2 to the last on Q1 (the highest)
If Not Sales.Exists(arrData(i, 1)) Then
Sales.Add arrData(i, 1), arrData(i, 2) 'We add the worker(Key) with his sales(Item)
Else
Sales(arrData(i, 1)) = Sales(arrData(i, 1)) + arrData(i, 2) 'if the worker already exists, sum his sales
End If
Next i
'Now you have all the workers just once
'If you want to delete column A and B and just leave the consolidate data:
With ThisWorkbook.Sheets("YourSheet") 'change this
i = .Cells(.Rows.Count, 1).End(xlUp).Row 'last row on column A
.Range("A2:B" & i).ClearContents
.Cells(2, 1).Resize(Sales.Count) = Application.Transpose(Sales.Keys) 'workers
.Cells(2, 2).Resize(Sales.Count) = Application.Transpose(Sales.Items) 'Their sales
End With
Application.ScreenUpdating = True 'return excel to normal
End Sub
To learn everything about dictionaries (and more) check this
With data in cols A and B like:
Running this short macro:
Sub KopyII()
Dim cell As Range, N As Long
Columns("A:A").Copy Range("C1")
ActiveSheet.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
N = Cells(Rows.Count, "C").End(xlUp).Row
Range("B1").Copy Range("D1")
Range("D2:D" & N).Formula = "=SUMPRODUCT(--(A:A= C2),(B:B))"
End Sub
will produce this in cols C and D:
NOTE:
This relies on Excel's builtin RemoveDuplicates feature.
EDIT#1:
As chris neilsen points out, this function should be a bit quicker to evaluate:
Sub KopyIII()
Dim cell As Range, N As Long, A As Range, C As Range
Set A = Range("A:A")
Set C = Range("C:C")
A.Copy C
C.RemoveDuplicates Columns:=1, Header:=xlNo
N = Cells(Rows.Count, "C").End(xlUp).Row
Range("B1").Copy Range("D1") ' the header
Range("D2:D" & N).Formula = "=SUMIFS(B:B,A:A,C2)"
End Sub
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'm trying to highlight the entire row grey if the value in column A begins with "ABC" as well as delete everything right of that cell. Any ideas on how to do this?
Dim DataRange As Range
Set DataRange = Range("A1:U" & LastRow)
Set MyRange = Range("A2:A" & LastRow)
For Each Cell In MyRange
If UCase(Left(Cell.Value, 3)) = "ABC" Then
Cell.EntireRow.Interior.ColorIndex = 15
Else
End If
Next
Here is pretty straightforward approach:
Dim lastRow As Long
Dim row As Long
Dim temp As String
' insert your sheet name here
With ThisWorkbook.Worksheets("your sheet name")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' you can change the starting row, right now its 1
For row = 1 To lastRow
' store whats in col A in a temporary variable
temp = Trim(CStr(.Range("A" & row).Value))
' if col A isn't 'ABC' clear & grey entire row
If UCase(Left(.Range("A" & row).Value), 3) <> "ABC" Then
.Rows(row).ClearContents
.Rows(row).Interior.ColorIndex = 15
' place temp variable value back in col A and make interior No Fill
.Range("A" & row).Value = temp
.Range("A" & row).Interior.ColorIndex = 0
End If
Next
End With
Here is another example; you stated "clear everything to the right" so I added offset to clear the contents of the cells not in column A.
Dim x As Long
For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If UCase(Left(Cells(x, 1).Value, 3)) = "ABC" Then
Range(Cells(x, 1), Cells(x, Columns.Count).End(xlToLeft)).Interior.ColorIndex = 15
Range(Cells(x, 1).Offset(, 1), Cells(x, Columns.Count).End(xlToLeft)).ClearContents
End If
Next x
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