I am trying to compare the values from one column of one sheet, with the values of another column of a different sheet, same workbook, though. It steps through each cell in the other column, and if the cell value, a string, does not exist in sheet2, then the row from sheet1 is copied over to sheet3. You can think of it like I'm comparing two arrays. I want to see if there are any values in Array1 that do not appear in Array2, and if they do not appear in Array1, the value is copied into Array3.
My main issue is I'm getting a type-mismatch error in line 5. The values contain strings. I am fairly new at Excel VBA and am trying to learn it on the fly. Any help would be greatly appreciated.
Sub search()
Dim count As Integer
count = 0
For Each i In Worksheets("Sheet1").Range("C2:C4503")
Set first_cell = Worksheets("Sheet1").Cells(i, 3) <-- Mismatch eror
For Each j In Worksheets("Sheet2").Range("X2:X4052")
Set second_cell = Worksheets("Sheet2").Cells(j, 24)
If second_cell = first_cell Then Exit For
Next j
count = count + 1
Set Worksheets("Sheet3").Cells(count, 1) = Worksheets("Sheet1").Cells(j, 1).Select
Next i
End Sub
Sub Search()
Dim rowNum As Long
Dim i As Range, f As Range
rowNum = 1
For Each i In Worksheets("Sheet1").Range("C2:C4503").Cells
If Len(i.Value) > 0 Then
'search for value on sheet2
Set f = Worksheets("Sheet2").Range("X2:X4052").Find( _
i.Value, , xlValues, xlWhole)
If f Is Nothing Then
'not found: copy row from sheet1>sheet3
i.EntireRow.Copy Worksheets("Sheet3").Cells(rowNum, 1)
rowNum = rowNum + 1
End If
End If
Next i
End Sub
The following:
For Each i In Worksheets("Sheet1").Range("C2:C4503")
...
Next i
iterates through the cells in the specified range; i is a Range object representing the current cell.
You are using it as in integer index in the following line:
Set first_cell = Worksheets("Sheet1").Cells(i, 3)
Hence the Type Mismatch.
Related
I have two ranges as showed in this picture.
I'm trying to write a VBA macro that successively selects a single cell in the first range (“B23, F27”) , copies the selected cell's value, then selects a random cell in the second range (“G23, K27”), and pastes the first cell's value into the randomly selected cell in the second range.
This should repeat until every cell from the first range has been copied, or every cell in the second range is filled with a new value. In this example both outcomes are equivalent as both ranges have the same number of cells (25).
The result should be like the second image.
I tried to assign the first range to an array and then pick a random value from this array and paste it to the second range.
I also tried to extract unique values from the first range, build a dictionary with it then pick a random cell from the second range and a random value from the dictionary and paste it.
Later I tried again using the VBA syntax “with range” and f"or each cell in range" but I can’t just come up with something that actually works. Sometimes the second range is filled by various values, but not as intended.
First example: this one just does not work
Sub fillrange()
Dim empty As Boolean
'This part checks if every cell in the first range as a value in it
For Each Cell In Range("B23", "F27")
If Cell.Value = "" Then
empty = True
End If
Next
'If every cell is filled then
If empty Then
Exit Sub
Else:
With ThisWorkbook.Worksheets("Sheet1)").Range("B23", "F27")
.Cells(Application.WorksheetFunction.RandBetween(1, 25)).Select
.Copy 'the cell select works, but it will copy all range
'This does not work
'For Each Cell In Range("G23", "K27")
'Cells(Application.WorksheetFunction.RandBetween(1, 25)).Select
'.PasteSpecial Paste:=xlPasteValues
'Next
End With
End If
End Sub
Second example: it fills the range but with wrong values
Sub fillrange2()
Dim empty As Boolean
For Each cell In Range("B23", "F27")
If cell.Value = "" Then
empty = True
'This part checks if every cell in the first range as a value in it
Exit For
End If
Next cell
If empty Then
Exit Sub
Else:
Dim ws As Worksheet
Dim lRow As Long, i As Long
Dim col As New Collection, itm As Variant
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 1 To lRow
On Error Resume Next
col.Add .Range("B23", "F27").Value, CStr(.Range("A" & i).Value)
On Error GoTo 0
Next i
End With
Dim MyAr() As Variant
ReDim MyAr(0 To (col.Count - 1))
For i = 1 To col.Count
MyAr(i - 1) = col.Item(i)
Next
For Each cell In Range("G23", "K27")
cell.Value = Application.WorksheetFunction.RandBetween(LBound(MyAr), UBound(MyAr))
Next
End If
End Sub
Third example: as the second example, it fills the range but with wrong values
Sub fillrange3()
Dim MyAr() As Variant
MyAr = Range("B23", "F27")
For Each cell In Range("G23", "K27")
cell.Value = Application.WorksheetFunction.RandBetween(LBound(MyAr), UBound(MyAr))
Next
End Sub
Maybe something like this ?
Sub test()
Set Rng = Range("G23:K27")
n = 1
totCell = 25
Set oFill = Range("G23")
Set oSource = Range("B23")
For i = 1 To 5
oFill.Value = "X" & n
oFill.AutoFill Destination:=Range(oFill, oFill.Offset(4, 0)), Type:=xlFillSeries
Set oFill = oFill.Offset(0, 1)
n = n + 5
Next i
For i = 1 To 5
Do
RndVal = Int((totCell - 1 + 1) * Rnd + 1)
xVal = "X" & RndVal
Set C = Rng.Find(xVal, lookat:=xlWhole)
If Not C Is Nothing Then
C.Value = oSource.Value
Set oSource = oSource.Offset(1, 0)
check = check + 1
If check = 5 Then Exit Do
End If
Loop
Set oSource = oSource.Offset(-5, 1)
check = 0
Next i
End Sub
I cheat by making a preparation for the range G23 to K27 fill with X1 to X25 in the first for i = 1 to 5.
The second for i = 1 to 5 is to offset from column B to G.
The Do - Loop is to generate random number between 1 to 25.
If the generated number is found then the found cell has the value from the "source",
if not found, it loop until the generated number is found 5 times (hence also the found cell is fill with 5 different source). Then before the next i, the "source" cell is offset to the next column.
This if I'm not wrong to get what you mean.
Here's another approach, just for a bit of variety.
Sub x()
Dim r1 As Range, r2 As Range, i As Long
Dim r As Long, c As Long
Set r1 = Range("B23").Resize(5, 5) 'define our two ranges
Set r2 = Range("G23").Resize(5, 5)
r2.ClearContents 'clear output range
With WorksheetFunction
Do Until .Count(r2) = r2.Count 'loop until output range filled
r = .RandBetween(1, 25) 'random output cell number
If .CountIf(r2, r1.Cells(i)) = 0 Then 'if not in output range already
If r2.Cells(r) = vbNullString Then 'if random cell empty
r2.Cells(r).Value = r1.Cells(i).Value 'transfer value
i = i + 1
End If
End If
Loop
End With
End Sub
So I am extremely new to VBA but have to finish a project that requires sorting some data. I have two sheets. One sheet( called 'values') has a single column of values that I need to test if a value matches at least one of the 5 columns of a record (row) in another very large sheet ('sheet1'), and copy the whole record (row) to a second spreadsheet ('sheet2).
This is my pseudo code:
for each row in sheet1 where sheet1.row = A1:Q1231231
for each value in values where values.value = b1:b300
for each col (e1:j1) where sheet1.col = E-rownum : J-rownum
if value == col-value
copy row to sheet2
break, esc value
Next row
And this is what i have so far, but i'm a little stuck on whether im referencing everything correctly. How do i just obtain columns E:J for each row when I need to match the values against those cells only? How do I copy the entire row if there is a match, and to immediately break and move on to the next record?
Private Sub CommandButton1_Click()
Dim sheetrow As Range
Dim Values As Range
Dim cells As Range
Set Sheet1 = Worksheets("Sheet1")
Set Values = Worksheets("values").Rows("B2:B330")
Set Sheet2 = Worksheets("Sheet2")
For Each sheetrow In Sheet1.Rows
For Each value In Values
For Each cell In sheetrow.cells // only need cell cols E:J
//if value == cell
// copy row to sheet2
//break (no need to check the rest of the row if match)
Next
Next
Next
End Sub
Just to inform, this is not for a VBA assignment. This is just a very large amount of data and a script would work better than trying to manually go through it. Thank you so much!
Your pseudo-code looks good, I did remove the 3rd loop though, albeit you could certainly loop through the columns.
Is this what you are looking for?
Option Explicit
Sub Test()
Dim i As Long
Dim j As Long
Dim rngValues As Range
Dim rng As Range
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Application.ScreenUpdating = False 'Turns of Screenupdating to let the code run faster
Set Sheet1 = ThisWorkbook.Sheets("Sheet1")
Set Sheet2 = ThisWorkbook.Sheets("Sheet2")
Set rngValues = ThisWorkbook.Sheets("Values").Range("B2:B330")
j = 1 'counter to count up the rows on the destination sheet
For i = 1 To Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row 'determines the last row on Sheet1
For Each rng In rngValues
'default return value of range is the value in it, so there would be no need to use range.value
' _ continues the code in the next line for readability
If Sheet1.Cells(i, 5).Value = rng.Value or Sheet1.Cells(i, 6).Value = rng.Value Or Sheet1.Cells(i, 7).Value = rng.Value or _
Sheet1.Cells(i, 8).Value = rng.Value or Sheet1.Cells(i, 9).Value = rng.Value Or Sheet1.Cells(i, 10).Value = rng.Value Then
'This copies the entire row an parses it to destination
Sheet1.Cells(i, 1).EntireRow.Copy Destination:=Sheet2.Cells(j, 1)
j = j + 1
End If
Next
Next
Application.ScreenUpdating = True
End Sub
I'm not sure if I understood your question correctly though.
Really hope you can help because i'm going blind on this issue. My spreadsheet has 20 columns and around 20,000 rows. Many rows are duplicates in all but 1 column and I need to Concatenate all the variables from that 1 column, where the rows match. My data is in order, so all duplicate rows are together and currently i have a macro but have to select a range by hand, which is slow.
My question is, can I run a VBA/formula that will match each duplicate partial row within a whole sheet, then concatenate the unique cell of those rows? please see my simplified example.
This code should do the job; I'm sure this question will be closed for being off-topic (or migrated to Stack Overflow, where it actually belongs):
Sub GatherCountries()
'''Subroutine to loop through rows of column A and concatenate data of column C to column D,
'''when row - 1 == row
'Declare local variable types
Dim worksheetName As String
Dim rowNumber, rowEndNumber As Integer
Dim pasteCell As Range
'Declare local variables
worksheetName = ActiveSheet.Name
rowEndNumber = FindLastRow(worksheetName) 'Function call to function defined below
'Loop through each row, starting at line 2 as header is line 1
For rowNumber = 2 To rowEndNumber
With Worksheets(worksheetName) 'Reduce amount of unnecessary repitition
'Case where cell Ax and Bx equal Ax-1 and Bx-1
If .Cells(rowNumber, 1) = .Cells(rowNumber - 1, 1) And _
.Cells(rowNumber, 2) = .Cells(rowNumber - 1, 2) Then
pasteCell.Value = pasteCell.Value & ", " & .Cells(rowNumber, 3) 'Concatenate country to existing string
'Case where cell Ax and Bx does not equal Ax-1 and Bx-1, loop will always enter this first
Else
Set pasteCell = .Cells(rowNumber, 4) 'Set the cell where concatenation should take place
pasteCell.Value = .Cells(rowNumber, 3) 'Populate concatenation cell with first entry of country
End If
End With
Next rowNumber
End Sub
Function FindLastRow(ByVal SheetName As String) As Long
'''Function to return the last row number of column A
Dim WS As Worksheet
On Error Resume Next
Set WS = ActiveWorkbook.Worksheets(SheetName)
FindLastRow = WS.Cells.Find(What:="*", After:=WS.Cells(1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row
On Error GoTo 0
End Function
With some more code it is possible to look up which columns contain the values to check and the values to concatenate, but given the structure of the example in the question, this will do the job as asked:
Input:
Output, after code has ran:
I have a worksheet that contains a varying amount of Rows of data in Column A , within this worksheet I need to search for a specific string then copy the data contained in the Cell adjacent to it and paste into Column C, i.e if data was found in A2 then i need to copy the data from B2 and paste into C1. I can easily find and copy when the string appears once but the string will appear more than once 100% of time. here is when i run into issues.
The temporary code I have written for ease of understanding, searches the spreadsheet for the last Mention of A, get the row number, copy the B cell for that row number then pastes the value into C1.
I guess you need to use range variables for this but not 100% sure how to do it.
i have found no way to copy all mentions of A into a column, or ideally sum up the contents of the B cells. (I can do this, just long winded)
Ive placed my code below.
Sub ValueFinder()
Dim LastALocation As String
Dim ValueContent As String
LastALocation = Range("A:A").Find(What:="A", after:=Range("A1"), searchdirection:=xlPrevious).Row
ValueContent = Cells(LastALocation, 2)
Cells(1, 3) = ValueContent
End Sub
The spreadsheet that its using for more information, contains A,B,C on a loop in Column A and the odd numbers in Column B.
Thanks for any help your able to provide.
Mark
This will look for a string in Column A, and add to Column C the same row's B Column Value.
Sub find_move()
Dim foundCel As Range
Dim findStr As String, firstAddress As String
Dim i As Long
i = 1
findStr = "A"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("C" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
End Sub
Note: You should add the worksheet in front of all the range values, i.e. Sheets("Sheet1").Range("A:A").Find(...
Consider:
Sub LookingForA()
Dim s As String, rng As Range, WhichRows() As Long
Dim rFound As Range
ReDim WhichRows(1)
s = "A"
Set rng = Range("A:A")
Set rFound = rng.Find(What:=s, After:=rng(1))
WhichRows(1) = rFound.Row
Cells(1, 3) = Cells(rFound.Row, 2)
Do
Set rFound = rng.FindNext(After:=rFound)
If rFound.Row = WhichRows(1) Then Exit Do
ReDim Preserve WhichRows(UBound(WhichRows) + 1)
WhichRows(UBound(WhichRows)) = rFound.Row
Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, 3) = Cells(rFound.Row, 2)
Loop
End Sub
This code builds column C. It also builds an internal array of the row numbers in the event they are needed later.
EDIT#1:
To read about dynamic arrays:
Dynamic Arrays
or Google:
Excel VBA dynamic array
Excel Data
The image is for the excel data I am playing around with. I will attach my code later. But I am trying to fill Column H with the first found cell of each row from Column A-E. Ex. for row 1 it should find "B" and place that to H, row 2 should have "c" place that to "H", and so on row 3 "is" to H, row 4 "a" to H.
I cannot for the life of me figure this out. VBA has never been my strongest suit and I have been playing around with this for 2 days now. Here is my code.
Function findValue() As String
Dim rng As Range
Dim row As Range
Dim cell As Range
Dim val As String
' Sets range of 5 columns to search in by column
Set rng = Range("A:E")
' searches through count of rows
For i = 2 To Range("A" & Rows.Count).End(xlUp).row
For Each cell In rng.Cells(i)
If IsEmpty(cell) = True Then
MsgBox cell
MsgBox i
Else
'MsgBox Range.(cell & i).Value
findValue = cell
Set rng = Range("A:E")
Exit For
End If
Next cell
Next i
End Function
Any Help is greatly appreciated.
The formula is:
=INDEX(A1:E1,AGGREGATE(15,6,COLUMN(A1:E1)/(A1:E1<>""),1))
If this is intended as a UDF, I believe that the following code is what you are after:
Function findValue() As String
Application.Volatile = True
Dim r As Long
Dim c As Long
r = Application.Caller.Row
For c = 1 To 5
If Not IsEmpty(Cells(r, c)) Then
findValue = Cells(r, c).Value
Exit Function
End If
Next
findValue = ""
End Function
An alternative method, where you pass the range to be checked rather than just checking the current row, would be:
Function findValue(rng As Range) As String
Dim c As Range
For Each c In rng
If Not IsEmpty(c) Then
findValue = c.Value
Exit Function
End If
Next
findValue = ""
End Function
This could then be used in cell H2 as =findvalue(A2:E2), and has the advantage that it does not need to be marked Volatile. ("Volatile" functions have to be recalculated every time anything at all changes on the worksheet.)
P.S. I strongly suggest that you use an Excel formula instead (such as the one in Scott's answer) - why reinvent the wheel when Excel already provides the functionality?
I'm not by my PC so can't test it, but you could try this
Sub FindValue()
Dim myRow As Range
' Sets Range of 5 columns to search in by column
Set rng = Intersect(Range("A:E"),ActiveSheet.UsedRange)
' searches through count of rows
For each myRow in rng.Rows
Cells(myRow.Row, "H").Value = myRow.Cells.SpecialCells(xlCellTypeConstants).Cells(1)
Next
End Sub