I have an Excel file with two sheets: Master and sheet two.
Master has one column of roughly 50 rows each containing a word.
Sheet two has 23 columns of varying lengths, the largest going up to 95 rows.
My goal is to use column one on Master to search each column on sheet 2 for text matches and then output all the matches below their respective columns on sheet 2.
The issue is after the first column on sheet 2 the matching often misses words.
Sub CompareFNL()
Application.ScreenUpdating = False
Dim WS As Worksheet
Set WS = Sheets("Master")
Dim rng As Range
Dim Column2 As Integer
Dim RowsMaster As Integer, Rows2 As Integer
RowsMaster = WS.Cells(100, 1).End(xlUp).row
Rows2 = Worksheets(2).Cells(100, 1).End(xlUp).row
Column2 = Worksheets(2).Cells(1, 24).End(xlToRight).Column
' Get the number of used rows for each sheet
With Worksheets(2)
For c = 1 To Column2
For i = 1 To Rows2
'Loop through Sheet 2
For j = 1 To RowsMaster
'Loop through the Master sheet
If .Cells(i, c) = WS.Cells(j, 1) Then
'If a match is found:
Worksheets(2).Cells(i + 110, c) = WS.Cells(j, 1)
'Copy int sheet2 in their respective columns
Exit For
End If
Next j
Next i
Next c
'Store blank cells inside a variable
On Error GoTo NoBlanksFound
Set rng = Range("a110:x250").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
'Delete blank cells and shift upward
rng.Rows.delete Shift:=xlShiftUp
'ERROR HANLDER
NoBlanksFound:
MsgBox "No Blank cells were found"
End With
Application.ScreenUpdating = True
End Sub
can you add .Cells(i,j).Value to see whether it works or not:
If .Cells(i, c).Value = WS.Cells(j, 1).Value Then
Related
I am stuck i don't know what code to use so i can search the same column twice for 2 different keyword and then copy data from the same row to another spreadsheet in sequence from a start cell. for details here's what i am trying to do.
Limit the search within a range of the worksheet (ex. Sheet 1 B1:N:200)
Search the 8th column (I) of the limit range Sheet1 for keyword ("Goods")
Copy the data found in the 2nd (C) and 5th column (F) of same row where instance "Goods " is found
Paste Value of Sheet 1 - column 2 to Sheet2 - Column 3 (no format values only), and Sheet 1 column 5 to Sheet 2 Column4 (with format and values) on a specific starting point (ex. Sheet 2 - B3) Next Match Result will be Sheet 2 - B4 and so on
5.Search AGAIN the 8th column of Sheet1 for keyword ("Services") starting from the top (B1:N1)
6.Copy the data found in the 2nd (C) and 5th column (F) of same row where instance "Services" is found
Paste Value of Sheet 1 - column 2 to Sheet2 - Column 3 (no format values only), and Sheet 1 column 5 to Sheet 2 Column4 (with format and values) to next row after the last PASTE from "Goods" was done. (ex last row match paste was C35 and D35 new found value should be paste in C36 a D36)
Ending Output should be all "Goods" results first then "Services" results
I hope i have conveyed what i need clearly
I am trying to work on this code that i found here but i just don't get how to insert the 2nd search loop for services., how to paste on specific cell in sheet2, how to follow the last row for services paste
Sub CopyCells
Dim lngLastRowSht1 As Long
Dim lngLastRowSht2 As Long
Dim counterSht1 As Long
Dim counterSht2 As Long
With Worksheets(1)
lngLastRowSht1 = .Cells(.Rows.Count, 8).End(xlUp).Row
lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
For counterSht1 = 1 To lngLastRowSht1
For counterSht2 = 1 To lngLastRowSht2
If Sheets(1).Range("" & (counterSht1)).Value = "Goods" Then
Sheets(2).Range("B" & (counterSht2), "D" & (counterSht2)).Value = Sheets(1).Range("C" & counterSht1, "D" & counterSht1).Value
End If
Next counterSht2
Next counterSht1
End With
End Sub
Edit1
As per request of sir Chris this is how it should look like
Answer for this Query was best solved by #CDP1802 Worked as needed.
I learned that I needed 2 counters for it to work :) and I also learned how to properly label target destination.
Thank you for this community:)
Increment the target row after each copy.
Option Explicit
Sub CopyCells()
Const ROW_START = 3
Dim wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
Dim n As Long, r As Long, lastrow1 As Long, lastrow2 as Long
Dim keywords, word, t0 As Single: t0 = Timer
keywords = Array("Goods", "Services")
Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
lastrow2 = ROW_START
Application.ScreenUpdating = False
With ws1
lastrow1 = .Cells(.Rows.Count, "I").End(xlUp).Row
For Each word In keywords
For r = 1 To lastrow1
If Len(.Cells(r, "I")) = 0 Then
Exit For
ElseIf .Cells(r, "I") = word Then
'Sht1 col 2 to Sht2 Col 3 (no format values only)
'Sht1 col 5 to Sht2 Col 4 (with format and values)
ws2.Cells(lastrow2, "C") = .Cells(r, "B")
ws2.Cells(lastrow2, "D") = .Cells(r, "E")
.Cells(r, "E").Copy
ws2.Cells(lastrow2, "D").PasteSpecial xlPasteFormats
lastrow2 = lastrow2 + 1
n = n + 1
End If
Next
Next
End With
Application.ScreenUpdating = True
MsgBox r - 1 & " rows scanned " & vbLf & n & " rows copied", _
vbInformation, Format(Timer - t0, "0.0 secs")
End Sub
You could make two routines: one for services and one for goods. But that code and the code above isn't very efficient.
Since Services & Goods are in the same column, try using the autofilter:
Sheets(2).UsedRange.autofilter Field:=8, Criteria1:=Array("Goods", "Services"), VisibleDropDown:=False, Operator:=xlFilterValues
Sheets(2).UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(1).Range("A1").PasteSpecial
Application.CutCopyMode = False
friends I have Two Excel Sheets which is shown below...
**Sheet_1** **Sheet_2**
ID Name Address ID Name Address
1 A Any 2 B Any
2 B Any 4 D Any
3 C Any 5 E Any
4 D Any
5 E Any
I want to delete all rows from Sheet_1 which is not in Sheet_2.
Note: ID of sheets is unique
I'm not sure if I got this right, but you want to delete rows that are not in Sheet2?
So that would make your Sheet1 to be a copy of Sheet2, wouldn't it?
Well, anyways, here is the code of the main Sub:
Sub Main()
Set idsToExclude = CreateObject("Scripting.Dictionary"): idsToExclude.CompareMode = TextCompare
'fill dictionary with IDs from sheet 2
Set idsToExclude = CreateDictFromColumns("Sheet2", "A", "B")
'find last populated row
xEndRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'iterate all rows from bottom to top
For i = xEndRow To 2 Step -1
'get value of cell at current row and 1st column
currentCellValue = ActiveSheet.Cells(i, 1).Value
'if row doesnt met criteria, delete it
If Not idsToExclude.Exists(currentCellValue) Then
Rows(i).Delete
End If
Next
End Sub
And the Function to get the Ids and names from a specific Sheet:
Function CreateDictFromColumns(sheet As String, keyCol As String, valCol As String) As Object
Set dict = CreateObject("Scripting.Dictionary"): dict.CompareMode = TextCompare
Dim rng As Range
Dim i As Long
Dim lastCol As Long '// for non-adjacent ("A:ZZ")
Dim lastRow As Long
lastRow = Sheets(sheet).Range(keyCol & Sheets(sheet).Rows.Count).End(xlUp).Row
Set rng = Sheets(sheet).Range(keyCol & "1:" & valCol & lastRow)
lastCol = rng.Columns.Count
For i = 2 To lastRow
If (rng(i, 1).Value = "") Then Exit Function
dict.Add rng(i, 1).Value, rng(i, lastCol).Value
Next
Set CreateDictFromColumns = dict
End Function
Note: If you want to make the contrary (delete IDs in Sheet1 that are in Sheet2), just remove the Not Operator from the following line:
If Not idsToExclude.Exists(currentCellValue) Then
As you can see, some parts are hard-coded. My suggestion is to adapt those parts and make it more dynamical, I had to write it like that due to lack of details in question.
I have a worksheet of data that has four columns. I want the spreadsheet to add 3 rows after each group based on column D. Column D has the department for the transactions. All department transactions are listed in a row. So Excel just needs to find the change in department and enter three rows after that section.
I have tried this code I found here. It puts a row after every line it sees the department in.
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("IMPORT-WIP") 'better define by name: ThisWorkbook.Worksheets("MySheet")
Dim LastRow_f As Long
LastRow_f = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
ws.Range("A1:D" & LastRow_f).AutoFilter Field:=12, Criteria1:="HR DEPARTMENT"
Dim FilteredData As Range
Set FilteredData = ws.Range("D2:D" & LastRow_f).SpecialCells(xlCellTypeVisible)
Dim iArea As Long
Dim iRow As Long
For iArea = FilteredData.Areas.Count To 1 Step -1 'loop from last to first area
For iRow = FilteredData.Areas(iArea).Rows.Count To 1 Step -1 'loop from last row to first row in each area
With FilteredData.Areas(iArea).Rows(iRow) '<-- this represents the current row we are in the loop
.Offset(RowOffset:=1).EntireRow.Insert Shift:=xlDown
.Offset(RowOffset:=1).EntireRow.Interior.Color = RGB(192, 192, 192)
End With
Next iRow
Next iArea
'remove filters
ws.Range("A1:D" & LastRow_f).AutoFilter
This code will insert 3 rows between groups of values (even unique values). The data does not need to be filtered. It will loop through Column D, test the cell above the current cell and, if not the same value, will insert 3 rows between them. You may have to sort the data first, depending on what you want.
Sub InsertRowsBetweenGroups()
Dim ws As Worksheet, lr As Long, i As Long
Set ws = ThisWorkbook.Sheets("Sheet1") 'Change as needed
lr = ws.Cells(ws.Rows.Count, 4).End(xlUp).Row
For i = lr - 1 To 2 Step -1
If Cells(i, "D") <> Cells(i - 1, "D") Then
Cells(i, "D").Resize(3).EntireRow.Insert Shift:=xlDown
End If
Next i
End Sub
Having issues with some vba, if anyone can point me in the right direction it would be greatly appreciated, currently my code is returning a full row of data and it is returning multiple rows, this is my current code.
Sub BUTTONtest_Click()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Two Years")
Set Target = ActiveWorkbook.Worksheets("Two Years League")
j = 3 ' Start copying to row 1 in target sheet
For Each c In Source.Range("G6:K6") ' Do 50 rows
If c.Text = "OVER" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub
I need to look at each row and in each row if the word "OVER" appears I need it to return the information in the side bar e.g. column B I would need this to apply for each wee section e.g. Column C- F should return the number from column B and H-K should return G etc.
This?
Sub BUTTONtest_Click()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Two Years")
Set Target = ActiveWorkbook.Worksheets("Two Years League")
j = 3 ' Start copying to row 1 in target sheet
For i = 1 To 3 'Number of ¿wees?
For Each c In Source.Range(Cells(6, 5 * i - 2), Cells(50, 5 * i + 1)) ' Do 50 rows
If c.Text = "OVER" Then
Target.Cells(j, 1) = Source.Cells(c.Row, 5 * i - 3)
j = j + 1
End If
Next c
Next i
End Sub
EDIT
If don't want repeated rows, try this one:
Sub BUTTONtest_Click()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Two Years")
Set Target = ActiveWorkbook.Worksheets("Two Years League")
j = 3 ' Start copying to row 1 in target sheet
a = 1
For i = 1 To 3 'Number of ¿wees?
For Each c In Source.Range(Cells(6, 5 * i - 2), Cells(50, 5 * i + 1)) ' Do 50 rows
If c.Text = "OVER" Then
If a <> c.Row Then
Target.Cells(j, 1) = Source.Cells(c.Row, 5 * i - 3)
j = j + 1
a = c.Row
End If
End If
Next c
Next i
End Sub
you could try this code (commented)
Option Explicit
Sub BUTTONtest_Click()
Dim Source As Worksheet
Dim Target As Worksheet
Dim iSection As Long
Dim sectionIniCol As Long, sectionEndCol As Long
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Two Years")
Set Target = ActiveWorkbook.Worksheets("Two Years League")
With Source '<--| reference 'Source' sheet
With .Range("B6:F" & .Cells(.Rows.Count, "B").End(xlUp).row) '<--| reference its columns "B:F" range from row 6 down to last non empty cell in column "B"
With .Offset(, -1).Resize(, 1) '<--| reference corresponding cells in column "A" (which is an empty column)
For iSection = 1 To 3 '<-- loop over all your three 5-columns sections
sectionIniCol = (iSection - 1) * 5 + 2 '<-- evaluate current section initial col
sectionEndCol = sectionIniCol + 4 '<-- evaluate current section ending col
.FormulaR1C1 = "=if(countif(RC" & sectionIniCol + 1 & ":RC" & sectionEndCol & ",""OVER"")>0,1,"""")" '<-- write (temporary) formulas in column "A" cells to result "1" should at least one "OVER" occurrence be in corresponding cells of current section columns
If WorksheetFunction.Sum(.Cells) > 1 Then Intersect(.Columns(sectionIniCol), .SpecialCells(xlCellTypeFormulas, xlNumbers).EntireRow).Copy Target.Cells(Target.Rows.Count, 1).End(xlUp).Offset(1) '<-- if any occurrence of "OVER" has been found then copy section initial column cells corresponding to column "A" cells marked with "1" and paste them in from first empty row of 'Target' sheet...
Next iSection
.ClearContents '<--| delete (temporary) formulas in target column "A"
End With
End With
End With
End Sub
I have two worksheets in the same workbook. In Sheet1 Column 1 is of expected stock barcodes, in Sheet2, Column 2 is comprised of the barcodes which I scanned.
I wrote a formula in conditional formatting to check items Column 2 and color them if they are not in Column 1, but I don't want to have to scroll through the entire list to see this.
What I want to do is populate a third (and fourth for quantity) column with only entries that are in Column 2 and not Column 1, and if possible, list the number of times it was found in Column 2.
Example:
Column 1
bc123
bc1234
bc12345
bc123456
bc1234567
Column 2
bc12345
bc123456
bc56789
bc67890
bc67890
Column 3 (Automatically populated with unique entries from column 2)
bc56789 1
bc67890 2
Thank you!
Here, my VBA approach for your problem:
Public Sub findAndCount()
Dim sh1, sh2 As Worksheet
Dim foundCell As Range
Dim startSheet2, resultRow As Integer
'Set sheets
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
'Set the start row of column from Sheet2
startRow = 1
resultRow = 1
'Clear old result from column C & D of Sheet1
sh1.Range("C:D").ClearContents
'Loop all row of column 2 from Sheet2 until blank
Do While sh2.Range("B" & startRow) <> ""
'Find value in column A of Sheet1
Set foundCell = sh1.Range("A:A").Find(sh2.Range("B" & startRow), LookIn:=xlValues)
'If match value is not found
If foundCell Is Nothing Then
'Find result is already exist or not
Set foundCell = sh1.Range("C:C").Find(sh2.Range("B" & startRow), LookIn:=xlValues)
'If result is not exist, add new result. (Here, I show result in Sheet1, you can change it.)
If foundCell Is Nothing Then
'Set barcode
sh1.Range("C" & resultRow) = sh2.Range("B" & startRow)
'Set count
sh1.Range("D" & resultRow) = 1
'Increase result row
resultRow = resultRow + 1
'If already exist
Else
'Increase count
foundCell.Offset(0, 1) = foundCell.Offset(0, 1).Value + 1
End If
End If
'Increase row
startRow = startRow + 1
Loop
End Sub