I have two spreadsheets. Each spreadsheet contains rows with various bits of information on them, including a unique identifier number (an ISBN in this case).
I am trying to make a script that determines a record is present on the working sheet (obtaining ISBN from column A – working sheet is called ePubWorking), and marks a column (V) on the master sheet (ePubMaster) in the row that contains the same ISBN as found on the previous sheet (the ISBN on the new sheet is also kept in column A). It needs to do this for each record found on the ePubWorking sheet.
I’ve tried a few variants of code I’ve found on here, but I can’t seem to get anything to work. This is what I’m currently working with (which doesn’t appear to be doing anything):
Dim rCell As Range
Dim rFind As Range
Dim iColumn As Integer
For Each rCell In Sheets("ePubWorking").Range("A2", Sheets("ePubWorking").Cells(Rows.Count, "A").End(xlUp))
Set rFind = Sheets("ePubMaster").Rows(1).Find(What:=Trim(rCell.Value), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
rCell.Offset(0, 2).Value = "Sent"
If Not rFind Is Nothing Then
rFind.Offset(0, 21).Value = "Sent"
End If
Next rCell
Nothing is happening using the above (or any of my other variants). I can't even get the "Sent" part to appear on the secondary sheet.
Can anyone point me in the right direction please?
Ok so thanks for the guidance, obviously I'd been banging my head on frankenstein attempts for too long and got blinded to what I was doing. As Zac pointed I was looking along the wrong axis on the ePubMaster sheet.
Working code:
Dim wb As Workbook: Set wb = ThisWorkbook
Dim workingSheet As Worksheet: Set workingSheet = wb.Sheets("ePubWorking")
Dim masterSheet As Worksheet: Set masterSheet = wb.Sheets("ePubMaster")
Dim workingRange As Range: Set workingRange = Range(workingSheet.Range("A2"), workingSheet.Cells(workingSheet.Rows.Count, "A").End(xlUp))
Dim rCell As Range
Dim rFind As Range
For Each rCell In workingRange
If Not rCell.Value = vbNullString Then
Set rFind = masterSheet.Rows.Find(What:=Trim(rCell.Value), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
rCell.Offset(0, 2).Value = "Sent"
If Not rFind Is Nothing Then
rFind.Offset(0, 21).Value = "Sent"
End If
End If
Next rCell
Related
I have a requirement to automate a step to copy data from one sheet to another using excel macro.
But below are the problem I am facing with this requirement:
Need to copy paste in scope data i.e. filter on 'Data Scope' = Yes
Column sequence of source and target are different and since there are around 127 columns so could not hardcode this part.
Please help if you have a handy code or logic to implement the same.
Found a simple way to implement this, posting it here for others to use.
Sub Reorganize_columns()
Dim v As Variant, x As Variant, findfield As Variant
Dim oCell As Range
Dim rng As Range
Dim iNum As Long
Dim sht_source As Worksheet, sht_target As Worksheet
Set sht_source = ActiveWorkbook.Sheets("Data")
Set sht_target = ActiveWorkbook.Sheets("Macro")
sht_source.Range("A1").AutoFilter Field:=1, Criteria1:="Yes"
Set rng = sht_target.Range("A1:HS1")
For Each cell In rng
iNum = iNum + 1
findfield = cell.Value
Set oCell = sht_source.Rows(1).Find(What:=findfield, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
sht_source.Columns(oCell.Column).Copy
sht_target.Columns(iNum).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Next cell
ActiveWorkbook.Save
MsgBox "Completed"
End Sub
I'm working on a VBA Macro for a database I have in Excel. I've got one Worksheet that stores information such as names, emails etc. (sadly those are not consistently placed in the same columns across all worksheets, but the email adresses span from "B:F"), this database is split into multiple worksheets. Except all those worksheets, I have also got one other worksheet ("Sheet2" in the code below) that stores all the email addresses that have assigned to my newsletter. (The only information in this sheet are the email addresses in the "A" column).
The VBA I'm working on should loop through all the email adresses that have subscribed to the newsletter ("Sheet2") and check if they're stored in "the database" - in the other sheets as well. If not, then give a warning - write "NOTFOUND" in the cell next to the email.
For some reason, VBA gives me a run-time error "Object doesn't support this property or method" on the row:
With Sheets(sheetIndex).Range("B:F").
Originally I thought that the reason for that is that I have not activated the Sheets, but I'm still getting the error.
The code I came up with so far:
Sub Search_for_emails()
Dim scanstring As String
Dim foundscan As Range
Dim lastRowIndex As Long
Dim ASheet As Worksheet
Set ASheet = Sheets("Sheet2")
lastRowInteger = ASheet.Range("A1", ASheet.Range("A1").End(xlDown)).Rows.Count
For rowNum = 1 To lastRowInteger
scanstring = Sheets("Sheet2").Cells(rowNum, 1).Value
For sheetIndex = 1 To ThisWorkbook.Sheets.Count
Sheets(sheetIndex).Activate
If Sheets(sheetIndex).Name <> "Sheet2" Then
With Sheets(sheetIndex).Range("B:F")
Set foundscan = .Find(What:=scanstring, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End With
If foundscan Is Nothing Then
ASheet.Cells(rowNum, 2).Value = "NOTFOUND"
Else
' ASheet.Cells(rowNum, 2).Value = foundscan.Rows.Count
End If
End If
Next
Next rowNum
End Sub
Some points:
You should avoid Activate - no need for that.
You should always qualify things like
sheet or range, else Excel will use the active workbook /
sheet, and that is not always what you want.
There is a difference between the Sheets and the Worksheets collection. A Chart-sheet, for example, has no cells and therefore no Range.
You are declaring a variable lastRowIndex but uses lastRowInteger. To avoid such errors, always put Option Explicit at the top of your code.
Change your Sub to
Sub Search_for_emails()
Dim scanstring As String
Dim foundscan As Range
Dim lastRowIndex As Long, rowNum As Long
Dim ASheet As Worksheet
Set ASheet = ThisWorkbook.Worksheets("Sheet2")
lastRowIndex = ASheet.Range("A1", ASheet.Range("A1").End(xlDown)).Rows.Count
For rowNum = 1 To lastRowIndex
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Sheet2" Then
With ws.Range("B:F")
Set foundscan = .Find(What:=scanstring, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End With
If foundscan Is Nothing Then
ASheet.Cells(rowNum, 2).Value = "NOTFOUND"
Else
' ASheet.Cells(rowNum, 2).Value = foundscan.Rows.Count
End If
End If
Next
Next rowNum
End Sub
I am trying to achieve the following:
I have a VBA button that when clicked, copies the active worksheet and pastes it into a new worksheet (I have this function already working perfectly - see code below).
I then want the newly pasted worksheet to find two specified cells, which contain the texts ("bus start") and ("bus finish") and clear all the contents in the cells that are in between the range of the two specified cells.
The rows are dynamic and will change over time as rows get added and deleted, hence why I cannot define a fixed range. Columns however, will not be deleted or added and therefore will be fixed.
For reference, here is my copy and paste code:
Private Sub WkCapBtn_Click()
Dim Ws1 As Worksheet
Set Ws1 = ActiveSheet
Ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Range("C3").Value = DateAdd("d", 7, ActiveSheet.Range("C3"))
ActiveSheet.Name = Format(ActiveSheet.Range("A1").Value, ("dd-mmm-yy"))
End Sub
My initial thinking was to use a .Find function to locate the specified cells and then use a .Offset to select the cells below and above. Where I am stuck though is actually trying to define the range between the specified cells.
If any additional information is needed, please let me know. Thank you in advance!
I corrected your code a little for the beginning:
Static WsCopy As Worksheet
Static Ws1 As Worksheet
Private Sub WkCapBtn_Click()
Set Ws1 = ThisWorkbook.Sheets("ORIGINALSHEETNAME")
Set WSCopy = Ws1.Copy After:=(ThisWorkbook.Sheets(Sheets.Count))
With WSCopy
.Name = Format(.Range("A1").Value, ("dd-mmm-yy"))
.Range("C3").Value = DateAdd("d", 7, .Range("C3"))
End With
End Sub
For your other sub you could set a variable for the cells containing either "bus start" or "bus finish". Can you try the following code and tell me if it worked?
Private Sub DelBusRange()
Dim BusStart As Range
Dim BusFinish As Range
With WsCopy
Set BusStart = .Find(What:="Bus start", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set BusFinish = .Find(What:="Bus finish", _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
.Range(BusStart, BusFinish).clear
End With
End Sub
Chris Neilson's code did the trick once I changed it around.
Private Sub WkCapBtn_Click()
Dim Ws1 As Worksheet
Dim FindBus1 As String
Dim FindBus2 As String
Dim BusMatch1 As Range
Dim BusMatch2 As Range
Set Ws1 = ActiveSheet
Ws1.Copy ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Range("C3").Value = DateAdd("d", 7, ActiveSheet.Range("C3"))
ActiveSheet.Name = Format(ActiveSheet.Range("A1").Value, ("dd-mmm-yy"))
FindBus1 = "Bus Start"
FindBus2 = "Bus Finish"
Set BusMatch1 = ActiveSheet.Cells.Find(FindBus1)
Set BusMatch2 = ActiveSheet.Cells.Find(FindBus2)
ActiveSheet.Range(BusMatch1.Offset(3, 1), BusMatch2.Offset(-2, 1)).ClearContents
End Sub
All. I am new to VBA and MS EXCEl 2010. I just started to play with the macro module in EXCEL yesterday, almost zero experience.
What I was trying to do is described as follows. First search for value records in a range in sheet1, then for each cell I found, I locate that row and pull out another cell value at that row. Using this value to do another search in a range in sheet2. I'll point out the problem I am having after my code. Here is the pesudcode.
Dim Found As Range
With RangeInSheet1
Set Found = .Find(value1)
If Not Found Is Nothing Then
firstAddress = Found.Address
Do
With RangeInSheet2
ColumnIndex = .Find(value2).Column
End With
Set Found = .FindNext(Found)
Loop While Not Found Is Nothing And Found.Address <> firstAddress
End If
End With
value1 is the key I used to search in RangeSheet1, and value2 in RangeSheet2. The above code goes through every record I found for value1 in sheet 1 and do another search in Sheet2.
Now let's Say value1 = 1, value2 =2007, and there are 5 records that contains value1 in sheet 1. The problem arises from this line of code "ColumnIndex = .Find(value2).Column".
Supposedly, for all the five found records, value of Found should always be 1 after "Set Found = .FindNext(Found)" is executed . But, after I added this ColumnIndex code, value of Found is set to 2007, which is so weird to me. Anyone knows what the problem is? Any help will be appreciate. I really need to keep the Found behaves "normal" as I want.
If anything is unclear, please let me know
.Find/.Findnext remembers the last setting. And hence it is always advisable to completely Specify the parameters. specially After:= parameter. It will also remember what was your last search term i.e What:=
Here is a demonstration on how to work with .Find/.Findnext
Also do not use Value2 as a variable. It is a reserved word. Instead of using Value1 and Value2, I am using sSearch1 and sSearch2 in the below code
Let's say your sheets look like this
Now Try this code
Sub Sample()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngWs1 As Range, rngWs2 As Range
Dim aCell As Range, bCell As Range, cCell As Range, dCell As Range, eCell As Range, cl As Range
Dim sSearch1, sSearch2
Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set rngWs1 = ws1.Range("A1:A10")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set rngWs2 = ws2.Cells
With ws1
For i = 1 To 10
sSearch1 = .Range("A" & i).Value
Set aCell = .Range("A" & i)
If Len(Trim(sSearch1)) <> 0 Then
Set aCell = rngWs1.Find(What:=sSearch1, After:=aCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
sSearch2 = aCell.Offset(, 1).Value
With ws2
Set bCell = rngWs2.Find(What:=sSearch2, After:=.Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not bCell Is Nothing Then
Debug.Print "For " & sSearch1 & ", " & sSearch2 & " Found in " & bCell.Address
Set cCell = bCell
Do
Set bCell = rngWs2.FindNext(After:=bCell)
If Not bCell Is Nothing Then
If bCell.Address = cCell.Address Then Exit Do
Debug.Print "For " & sSearch1 & ", " & sSearch2 & " Found in " & bCell.Address
Else
Exit Do
End If
Loop
End If
End With
End If
End If
Next
End With
End Sub
This is the result that we get.
I am struggling for writing the code - below query please help any one on writing it.
TestDataSheetName = ActiveWorkbook.Worksheets(x).Name
ActiveWorkbook.Worksheets(x).Activate
CountTestData = ActiveWorkbook.Worksheets(x).Range("A" & Rows.Count).End(xlUp).Row
Range("A10").Select
Range("A10").AutoFilter
Selection.AutoFilter Field:=14, Criteria1:=">=" & DateToday
ActiveWorkbook.Worksheets(x).Activate
CountTestDataAftFilter = ActiveWorkbook.Worksheets(x).Range("A1", Range("A65536").End(xlUp)).SpecialCells(xlCellTypeVisible).Count
MsgBox CountTestDataAftFilter
For w = 10 To CountTestDataAftFilter
Set Foundcell1 = ActiveWorkbook.Worksheets(x).Cells.Find(What:=DateToday, After:=[ActiveCell], _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)
Next
' after filtering with today's date i got 5 rows with today's date and i have written for loop for getting all row values but after finding first row then it is not finding the second row value and it is again start with first row
Please help me on above code.
Thanks&Regards,
Basha
You're looking for the .FindNext function. Try something like this: (Please note, you may need to modify this code slightly to fit your particular case.)
Sub UseFindNext()
Dim TestDataSheet As Worksheet
Dim FoundCell1 As Range
Dim DateToday As Date
Dim firstAddress As String
Dim x As Long
Dim CountTestData As Long
Dim CountTestDataAftFilter As Long
x = 1
Set TestDataSheet = ActiveWorkbook.Worksheets(x)
CountTestData = TestDataSheet.Range("A" & Rows.count).End(xlUp).Row
Range("A10").AutoFilter Field:=14, Criteria1:=">=" & DateToday
CountTestDataAftFilter = TestDataSheet.Range("A1", Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).count
Set FoundCell1 = TestDataSheet.Cells.Find(What:=DateToday, After:=TestDataSheet.Range("A10"), _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)
firstAddress = FoundCell1.Address
Do
'Do whatever you're looking to do with each cell here. For example:
Debug.Print FoundCell1.Value
Loop While Not FoundCell1 Is Nothing And FoundCell1.Address <> firstAddress
End Sub
I don't know why you have to go through each value.
You already used AutoFilter to get the data you want.
But here's another approach that might work for you.
Sub test()
Dim ws As Worksheet
Dim wb As Workbook
Dim DateToday As String 'i declared it as string for the filtering
Dim rng, cel As Range
Dim lrow As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets(x)
DateToday = "Put here whatever data you want" 'put value on your variable
With ws
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("N10:N" & lrow).AutoFilter Field:=1, Criteria1:=DateToday
'I used offset here based on the assumption that your data has headers.
Set rng = .Range("N10:N" & lrow).Offset(1, 0).SpecialCells(xlCellTypeVisible)
'here you can manipulate the each cell values of the currently filtered range
For Each cel In rng
cel.EntireRow 'use .EntireRow to get all the data in the row and do your stuff
Next cel
.AutoFilterMode = False
End With
End Sub
BTW, this is based on this post which you might want to check as well to improve coding.
It is a good read. Hope this helps.