I'm writing code that searches through a very large excel sheet with a lot of duplicates, I can easily sort the duplicates together as they all have 1 matching column, and ID column. The thing that I am stuck on is why IsEmpty isn't working for looking at the current cell and seeing if it's empty and if the next cell (the duplicate) has data. Then the cell with data would merge over into the cell that's empty.
I've tried using Range as the argument as well as cells to no avail.
Private Sub CountDuplicates()
Dim i As Integer
'The cell it will use to search
Dim idCheck As Range
'The cell it will use to compare text
Dim currentCell As Range
'This will be used to format the "Changes" column
Dim rowNumberValue As Integer, columnNumberValue As Integer, rowBelow As Integer
placement = 0
colNum = 3
rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column
rowBelow = ActiveCell.Row + 1
'Searches by ID column
For Each idCheck In Worksheets("Sheet1").Range("B2:B1000")
'This checks to find duplicate ID rows
If idCheck.Value = idCheck.Offset(-1, 0).Value Then
'Goes from each column starting from the ID column (H = 7th letter in alphabet and H is the last column)
For colNum = 3 To 7
'Checks to see if the cell has no value but the duplicate does
If IsEmpty(Range(Cells(rowNumberValue, colNum))) = True And IsEmpty(Range(Cells(rowNumberValue + 1, colNum))) = False Then
Range(Cells(rowNumberValue, colNum), Cells(rowBelow, colNum)).Merge
So ideally, if a row has one cell missing data, but the other row has it, then merge/copy the data into the cell with missing data.
Replace tests like:
IsEmpty(Range(Cells(rowNumberValue, colNum))) = True
with:
Cells(rowNumberValue, colNum) = ""
Related
Goes directly to MsgBox without seemingly changing anything.
I've been playing around with this code for awhile now since I'm new to VBA. I'm aware this script isn't pointed at a specific spreadsheet.
Private Sub MergeData()
'The cell it will use to search
Dim idCheck As Range
'The cell it will use to compare text
Dim currentCell As Range
'The cell is will use to compare duplicates
Dim oneRowBelow As Range
'Will briefly say if something changed in furthest column
Dim changes As String
'This will be used to format the "Changes" column
Dim rowNumberValue As Integer, columnNumberValue As Integer, rowBelow As Integer
colNum = 3
rowNumberValue = ActiveCell.Row
columnNumberValue = ActiveCell.Column
rowBelow = ActiveCell.Row + 1
'Searches by ID column
For Each idCheck In Worksheets("Test").Range("B2:B1000")
'This checks to find duplicate ID rows
If idCheck.Value = idCheck.Offset(-1, 0).Value Then
'Goes from each column starting from the ID column (H = 7th letter in alphabet and H is the last column)
'Technically S is the last column since S just lists what has changed
For colNum = 3 To 7
'Checks to see if the current cell has no value but the duplicate cell does
If Cells(rowNumberValue, colNum) = "" And Cells(rowBelow, colNum) <> "" Then
'Changes current cell value to the duplicate cell value
Cells(rowNumberValue, colNum) = Cells(rowBelow, colNum)
'Writes in the 19th column whether or not data has been changed
changes = "Added"
Cells(rowNumberValue, 19) = changes
Cells(rowNumberValue, 19).Interior.ColorIndex = 4
End If
'Checks to see if current cell has value but the duplicate cell doesn't
If Cells(rowNumberValue, colNum) <> "" And Cells(rowBelow, colNum) = "" Then
'Merges the two cells ( Unfortunately .Merge takes the top cell value only)
Range(Cells(rowNumberValue, colNum), Cells(rowBelow, colNum)).Merge
'Writes in the 19th column whether or not data has been changed
changes = "Added"
Cells(rowNumberValue, 19) = changes
Cells(rowNumberValue, 19).Interior.ColorIndex = 4
End If
'Checks to see if the cell value is different from the duplicate value
If Cells(rowNumberValue, colNum) <> Cells(rowBelow, colNum) Then
'This just sets the first value to the duplicate value (since it doesn't matter which one is overwritten)
Cells(rowBelow, colNum) = Cells(rowNumberValue, colNum)
'Writes in the 19th column whether or not data has been changed
changes = "Changed"
Cells(rowNumberValue, 19) = changes
Cells(rowNumberValue, 19).Interior.ColorIndex = 6
End If
Next colNum
End If
colNum = 3
Next
MsgBox "All done"
End Sub
So for example, if two rows have the number 123 in their ID column, and the Name column in the first row lists Timothy and the second row lists Tim, the script should change the row to say Bob and say in the furthest column what was changed. Or, if the first or second row has an empty cell while the other row doesn't, the data from the non-empty cell would be merged/copied over to the empty one.
It doesn't matter which data is overwritten, as long as all empty cells that can be filled, are filled.
From my comment, I believe you're causing false conditions due to where your variables are defined:
'Searches by ID column
For Each idCheck In Worksheets("Test").Range("B2:B1000")
'find current cell's row to be used in if-statements
rowNumberValue = ActiveCell.Row 'MOVED INTO ROW LOOP ==============
rowBelow = ActiveCell.Row + 1 'MOVED INTO ROW LOOP ==============
'This checks to find duplicate ID rows
If idCheck.Value = idCheck.Offset(-1, 0).Value Then
'Goes from each column starting from the ID column (H = 7th letter in alphabet and H is the last column)
'Technically S is the last column since S just lists what has changed
For colNum = 3 To 7 'COLNUM IS DEFINED, NOT NEEDED BEFOREHAND ==========
columnNumberValue = ActiveCell.Column 'if you need this, put it inside of this section, but you shouldn't need it due to colNum existing =========
'Your other code here
Next colNum
End If
Next
You also don't need to reset, manually, your colNum to 3 at the end, due to the For loop doing that when it iterates.
Flagged my comments/changes in your code with ======== after the comments.
I am new to VBA and need some help to come up a code to solve this. eg. I want to loop search column B to H in each row and return a specific cell value.
eg. loop search Column B to H for row 7 and once "p20028" cell (E7) is located based on column J. Return/copy "sa2084" at D5 to cell I7.
Sub whereused()
Dim part_num_1 As String
Dim finalrow As Integer
Dim row As Integer
Dim column As integer
finalrow = Sheet("Sheet1").Range("J1400").End(x1up).row
For row = 3 To finalrow
For column = 1 To 8
part_num = Sheets("Sheet1").Cells(row, 10).Value
If Cells(row, column).Value = part_num Then
End If
Next column
Next row
End Sub
I would like to write a VBA macro for excel through which i want data from a master sheet to populated to another sheets conditionally.
for example, my master sheet ("Sheet1) has multiple rows and column. The condition for data population from Sheet1 to Sheet2 should be based on these condition
(1) Only rows which has a particular string in a column (say "keyword" string in column D)
(2) Only few columns to be copied from Sheet1 to Sheet2 (say column A,B,E & G)
I have a code that copies a column when the heading of the column is a certain string, would that help?
Edit1:
Here is what I have come up with. The code should be flexible enough to adapt to any type of spreadsheet you've got
Dim keyColumn As Integer
Dim i As Integer
Dim keyWord As Variant 'I've used variant, so you can choose your own data type for the keyword
Dim dataSh As String 'I'm using sheet names for sheet referencing
Dim populateSh As String
Dim rowNum As Integer
Dim dataRow() As Variant
Sub Populate()
'set the column number, which contains the keywords, the keyword itself,
'name of the sheet to populate and the row offset you'd like to start populating
populateSh = "populate"
keyColumn = 4
keyWord = "yes"
rowNum = 0
'assuming you run the macro in the sheet you get the data from, get its name to return to it after copying the row
dataSh = ActiveSheet.Name
'loop through all the used cells in the column
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(i, keyColumn) = keyWord Then
'starting in row 1 in the sheet you populate, you'll have to set the rowNum variable to desired offset few lines above
rowNum = rowNum + 1
Call copyRow(i, rowNum)
End If
Next i
End Sub
Sub copyRow(ByVal cRow As Integer, ByVal pRow As Integer)
Dim colNum As Integer
'set the number of columns you'd like to copy
colNum = 3
'redimension the array to carry the data to other sheet
'this can be done any way you,d like, but I'm using array for flexibility
ReDim dataRow(1 To colNum)
'put the data into the array, as an example I'm using columns 1, 2 and 3, while skipping the keyword column.
dataRow(1) = Cells(cRow, 1)
dataRow(2) = Cells(cRow, 2)
dataRow(3) = Cells(cRow, 3)
Sheets(populateSh).Select
For p = 1 To UBound(dataRow)
Cells(pRow, p) = dataRow(p)
Next p
Sheets(dataSh).Select
End Sub
Hope that helps. Sorry for any style errors in advance
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.
I have the following grid of data:
---------Header 1 Header 2 Header 3 Header 4
Row 1 x x x
Row 2 x x
Row 3 x
Row 4 x x x x
I then have a second sheet that looks like this:
Row 1 Row 2 Row 3 Row 4
I would like the second sheet to end up looking like this:
Row 1 Row 2 Row 3 Row 4
Header 1 Header 2 Header 3 Header 1
Header 3 Header 3 Header 2
Header 4 Header 3
. Header 4
Ignore that last period, I just used it to format it properly.
I've been playing with MATCH and INDEX for a couple hours and while I can get pieces of it, I can't seem to get it to all work together.
EDIT:
I use 'Header 1' and 'Row 1' as examples only. The actual data is text in Column A and Row 1, respectively. Also, since the source data will be modified, I'd prefer to have something that would automatically update the second sheet.
Here is one way to do it with a VBA function:
In the Developer Tab(*) Click on Visual Basic, then click on the "Insert" menu there and choose "Module" to insert a new module. Then paste in the Following code:
Option Explicit
Public Function GetHeaderMatchingRow(RowText As String, _
SearchRange As Range, _
iHdrNo As Integer) As String
Dim rng As Range
Set rng = SearchRange
Dim cel As Range
'Get the Row to scan
Dim i As Long, rowOff As Long
For i = 2 To rng.Rows.Count
Set cel = rng.Cells(i, 1)
If cel.Value = RowText Then
rowOff = i
Exit For
End If
Next i
'Now, scan horizontally for the iHdrNo'th non-blank cell
Dim cnt As Integer
For i = 2 To rng.Columns.Count
Set cel = rng.Cells(rowOff, i)
If Not CStr(cel.Value) = "" Then
cnt = cnt + 1
If cnt = iHdrNo Then
GetHeaderMatchingRow = rng.Cells(1, i).Value
Exit Function
End If
End If
Next i
GetHeaderMatchingRow = ""
End Function
Click on the "Debug" menu and select "Compile VBAProject".
Now go back to Excel and in your first sheet define a Named Range to cover all of your data in the grid. The Row names should be the first column in this range and the Header text should be the first row in it.
Now go to your second sheet and enter a formula like this in every output cell:
=GetHeaderMatchingRow(A$1, RowHeaderRange, 1)
Where the First parameter is the Row text that it will try to match in the first column of the range. I have "A$1" here because the in my test, my second sheet's column headers are also the Row-names in my first sheet, just like yours.
The second argument is the range to search (in this case, the Named Range we defined earlier), and the third argument is the count of the match that it is looking for (1st, 2nd, 3rd, etc.).
Note that the first and third parameters should change based on what column and row the output is for.
Does it have to use worksheet functions? It would be quite a bit simpler to create a macro to do it (I've made an example)
Edited the function to work with row headers in col a and column headers in row 1 and changed it to read from "Source" sheet and write the result to "Output" sheet
Public Sub Example()
Dim Output As Worksheet
Dim Sheet As Worksheet
Dim Row As Integer
Dim Column As Integer
Set Sheet = ThisWorkbook.Worksheets("Source")
Set Output = ThisWorkbook.Worksheets("Output")
Output.Cells.Clear ' Since were going to rebuild the whole thing, just nuke it.
For Row = Sheet.UsedRange.Rows(Sheet.UsedRange.Rows.Count).Row To 2 Step -1
Output.Cells(1, Row - 1).Value = Sheet.Cells(Row, 1).Value
For Column = Sheet.UsedRange.Columns(Sheet.UsedRange.Columns.Count).Column To 1 Step -1
If Not IsEmpty(Sheet.Cells(Row, Column)) Then
Sheet.Cells(1, Column).Copy
Output.Cells(2, Row - 1).Insert xlShiftDown
End If
Next Column
Next Row
End Sub
I had a look at doing it with worksheet functions and as others have said its going to be pretty tricky to do it without some vba mixed in there.
If you add this to a new module then you can access it as a workbook function. (not that this is the best way to do it, just fancied having a go)
'Return The Column Header of the Nth Non-Blank Cell on Specified Row
Public Function NonBlankByIndex(ByVal Row As Integer, ByVal Index As Integer) As Range
Dim Sheet As Worksheet
Dim Column As Integer
Dim Result As Range
Set Sheet = ThisWorkbook.Worksheets("Source") ' Change to your source sheet's name
Set Result = Nothing
Column = 2 ' Skip 1 as its the header
Do
If Column > Sheet.UsedRange.Columns(Sheet.UsedRange.Columns.Count).Column Then
Exit Do
End If
If Sheet.Cells(Row, Column) = "" Then
Column = Column + 1
Else
If Index = 1 Then
Set Result = Sheet.Cells(1, Column)
Exit Do
Else
Column = Column + 1
Index = Index - 1
End If
End If
Loop
Set NonBlankByIndex = Result
End Function
If you are happy with blanks in the listing try this in sheet2!A2:
=IF(INDEX(Sheet1!$B$2:$E$5,MATCH(A$1,Sheet1!$A$2:$A$5,0),ROW()-1)="x",INDEX(Sheet1!$B$1:$E$1,1,ROW()-1),"")
Just copy the formula over range A2:D5