VBA check value from column A exists in another workbook - vba

I am trying to build a macro that loops through a range of values within colA and check if they exist with another workbook. In one of them I would like to mark it "Worked"/"Not Worked"
Any guidance on where to start?

Example
Here is an example of what you're looking for. Remember that both the workbooks have to be opened in the same instance of Excel.
Sub check()
Dim i As Integer, k As Integer, j As Integer 'Define your counting variables
Dim Report1 As Worksheet, bReport As Workbook, Report2 As Worksheet, bReport2 As Workbook 'Define your workbook/worksheet variables
Set Report1 = Excel.ActiveSheet 'Assign active worksheet to report1
Set bReport = Report1.Parent 'Assign the workbook of report 1 to breport
On Error GoTo wbNotOpen 'If an error occurs while accessing the named workbook, send to the "wbNotOpen" line.
Set bReport2 = Excel.Workbooks("otherworkbookname.xlsm") 'Assign the other workbook which you are cross-referencing to the bReport2 variable.
Set Report2 = bReport2.Worksheets("otherworksheetname") 'Do the same with the worksheet.
On Error GoTo 0 'Reset the error handler (to undo the wbNotOpen line.)
k = Report1.UsedRange.Rows.Count 'Get the last used row of the first worksheet.
j = Report2.UsedRange.Rows.Count 'Get the last used row of the second worksheet.
For i = 2 To k 'Loop through the used rows of the first worksheet. I started at "2" to omit the header.
'Next, I used the worksheet function "countIf" to quickly check if the value exists in the given range. This way we don't have to loop through the second worksheet each time.
If Application.WorksheetFunction.CountIf(Report2.Range(Report2.Cells(2, 1), Report2.Cells(j, 1)), Report1.Cells(i, 1).Value) > 0 Then
Report1.Cells(i, 5).Value = "Worked" 'If the value was found, enter "Worked" into column 5.
Else
Report1.Cells(i, 5).Value = "Not worked" 'If the value wasn't found, enter "Not worked" into column 5.
End If
Next i
Exit Sub
'This is triggered in the event of an error while access the "other workbook".
wbNotOpen:
MsgBox ("Workbook not open. Please open all workbooks then try again.")
Exit Sub
End Sub
This link also includes steps that tell how to check if a cell exists in another workbook. The comments are useful.
Excel macro - paste only non empty cells from one sheet to another (Stack Overflow)

Thanks to #Lopsided's solution, I have tweeked his code to bring forth this solution. And this seems to work.
{
Sub CheckValue()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim i As Integer
Dim k As Integer
Dim j As Integer
Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("Sheet2")
k = S1.UsedRange.Rows.Count
j = S2.UsedRange.Rows.Count
For i = 1 To k
If Application.WorksheetFunction.CountIf(S2.Range(S2.Cells(2, 1), S2.Cells(j, 1)), S1.Cells(i, 1).Value) > 0 Then
S1.Cells(i, 5).Value = "Worked" 'If the value was found, enter "Worked" into column 5.
Else
S1.Cells(i, 5).Value = "Not worked" 'If the value wasn't found, enter "Not worked" into column 5.
End If
Next i
End Sub
}

Related

Fill Empty Blank Cells with value within a region horizontaly defined

I'm trying to fill blank cells in a certain region with 0. The reagion should be defined in the current workbook but in sheet2 (not the current sheet). Also the place where it is supposed to fill is between columns
BU:CQ in the current region (not all 100 000 000 lines). Just the number of lines that define the table between columns BU and CQ. I know the problem lies in defining the region... See the code below.
What is missing?
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
InputValue = "0"
For Each cell In ThisWorkbook.Sheets("Sheet2").Range(BU).CurrentRegion
'.Cells(Rows.Count, 2).End(xlUp).Row
If IsEmpty(cell) Then
cell.Value = InputValue
End If
Next
End Sub
I've this code that i'm positive that works! But i don't wnat selection! I want somthing that specifies the sheet and a fixed range.
Now my idea is to replace "selection" with the desired range. - In this case in particular the range should be 1 - between BU:CQ; 2 - starting at row 2; 3 - working the way down until last row (not empty = end of the table that goes from column A to DE)
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "0"
End If
Next
End Sub'
PS: And I also need to specify the sheet, since the button that will execute the code will be in the same workbook but not in the same sheet.
Use SpecialsCells:
On Error Resume Next 'for the case the range would be all filled
With ws
Intersect(.UsedRange, .Range("BU:CQ")).SpecialCells(xlCellTypeBlanks).Value = 0
End With
On Error GoTo 0
MUCH faster than looping !
Try using cells() references, such as:
For i = cells(1,"BU").Column to cells(1,"CQ").Column
cells(1,i).value = "Moo"
Next i
In your current code you list Range(BU) which is not appropriate syntax. Note that Range() can be used for named ranges, e.g., Range("TheseCells"), but the actual cell references are written as Range("A1"), etc. For Cell(), you would use Cells(row,col).
Edit1
With if statement, with second loop:
Dim i as long, j as long, lr as long
lr = cells(rows.count,1).end(xlup).row
For i = 2 to lr 'assumes headers in row 1
For j = cells(1,"BU").Column to cells(1,"CQ").Column
If cells(i,j).value = "" then cells(i,j).value = "Moo"
Next j
Next i
First off, you should reference the worksheet you're working with using:
Set ws = Excel.Application.ThisWorkbook.Worksheets(MyWorksheetName)
Otherwise VBA is going to choose the worksheet for you, and it may or may not be the worksheet you want to work with.
And then use it to specify ranges on specific worksheets such as ws.Range or ws.Cells. This is a much better method for specifying which worksheet you're working on.
Now for your question:
I would reference the range using the following syntax:
Dim MyRange As Range
Set MyRange = ws.Range("BU:CQ")
I would iterate through the range like so:
Edit: I tested this and it works. Obviously you will want to change the range and worksheet reference; I assume you're competent enough to do this yourself. I didn't make a variable for my worksheet because another way to reference a worksheet is to use the worksheet's (Name) property in the property window, which you can set to whatever you want; this is a free, global variable.
Where I defined testWS in the properties window:
Public Sub test()
Dim MyRange As Range
Dim tblHeight As Long
Dim tblLength As Long
Dim offsetLen As Long
Dim i As Long
Dim j As Long
With testWS
'set this this to your "BU:CQ" range
Set MyRange = .Range("P:W")
'set this to "A:BU" to get the offset from A to BU
offsetLen = .Range("A:P").Columns.Count - 1
'set this to your "A" range
tblHeight = .Range("P" & .Rows.Count).End(xlUp).Row
tblLength = MyRange.Columns.Count
End With
'iterate through the number of rows
For i = 1 To tblHeight
'iterate through the number of columns
For j = 1 To tblLength
If IsEmpty(testWS.Cells(i, offsetLen + j).Value) Then
testWS.Cells(i, offsetLen + j).Value = 0
End If
Next
Next
End Sub
Before:
After (I stopped it early, so it didn't go through all the rows in the file):
If there's a better way to do this, then let me know.

Write on the next available cell of a given column

I have a somewhat simple macro that I have made but I am rusty as I have not coded in a few years. As simply as I can put it, I Have two different Workbooks. If the workbook I have open has a certain value (or no value), I want it to fill the other workbook("Test Template") with either "proposal or pre-proposal."
That has all been easy for me. But since the worksheet adds rows as we input data, I need it to fill those values in the next available row.
I will attach code but don't worry about the proposal stuff, I just need the range changed from a specific cell into the next available cell in the column. (if d28 is full, put in d29).
Public Sub foo()
Dim x As Workbook
Dim y As Workbook
'## Open both workbooks first:
Set x = ActiveWorkbook
Set y = Workbooks.Open("C:\Users\hmaggio\Desktop\Test Template.xlsx")
'copy Names from x(active):
x.Sheets("Sheet1").Range("C4").Copy
'paste to y worksheet(template):
y.Sheets("Sheet1").Range("B28").PasteSpecial
If x.Sheets("Sheet1").Range("C15") = "" Then
y.Sheets("Sheet1").Range("D28").Value = "proposal"
Else
y.Sheets("Sheet1").Range("D28").Value = "preproposal"
End If
First, you need a variable where you'll store the last used row number:
dim lngRows as long
lngRows = Cells(Rows.Count, "D").End(xlUp).Row
Then replace your lines of code where you have .Range("B28") with either .Cells(lngRows+1,2) or .Range("B"&lngRows)
The object Range offers a method called End that returns the last range on a certain direction.
Range("A1").End(xlDown) '<-- returns the last non-empty range going down from cell A1
Range("A1").End(xlUp) '<-- same, but going up
Range("A1").End(xlToRight) '<-- same, but going right
Range("A2").End(xlToLeft) '<-- same, but going left
In your case, hence, you can detect and use the last row of column B like this:
nextRow = y.Sheets("Sheet1").Range("B3").End(xlDown).Row + 1
More details:
The first Range of your column B is the header Range("B3")
You get the last filled range going down with .End(xlDown)
Specifically, you get the Row of that range
You add + 1 (cause you want the next available row
You store the row in the variable nextRow
... that you can then use like this:
y.Sheets("Sheet1").Range("B" & nextRow ).PasteSpecial
Try this
Public Sub foo()
Dim x As Workbook
Dim y As Workbook
Dim fromWs As Worksheet
Dim toWs As Worksheet
Dim Target As Range
'## Open both workbooks first:
Set x = ActiveWorkbook
Set y = Workbooks.Open("C:\Users\hmaggio\Desktop\Test Template.xlsx")
Set fromWs = x.Sheets("Sheet1")
Set toWs = y.Sheets("Sheet1")
With fromWs
Set Target = toWs.Range("b" & Rows.Count).End(xlUp)(2) '<~~next row Column B cell
Target = .Range("c4") 'Column B
If .Range("c15") = "" Then
Target.Offset(, 2) = "proposal" 'Column D
Else
Target.Offset(, 2) = "preproposal"
End If
End With
End Sub

VBA code only working correct in debug.mode

my VBA code is copy/pasting rows from several sheets in the workbook into another sheet based on a specific input criteria. It uses an InStr search to find the input criteria on sheets starting with "E" in column D between rows 17-50 - which is working good.
However, when activiting the sub through a button it only copy/pasts the first entry it finds and jumps to the next worksheet. In debug.mode it finds all entries in one worksheet, does copy/paste and only then jumps to the next worksheet.
What do I need to change?
Sub request_task_list()
Dim rPlacementCell As Range
Dim myValue As Variant
Dim i As Integer, icount As Integer
myValue = InputBox("Please enter the Name (Name or Surname) of the Person whos task you are looking for", "Input", "Hansen")
If myValue = "" Then
Exit Sub
Else
Set rPlacementCell = Worksheets("Collect_tool").Range("A3")
For Each Worksheet In ActiveWorkbook.Worksheets
'Only process if the sheet name starts with 'E'
If Left(Worksheet.Name, 1) = "E" Then
Worksheet.Select
For i = 17 To 50
If InStr(1, LCase(Range("D" & i)), LCase(myValue)) <> 0 Then
'In string search for input value from msg. box
'Copy the whole row if found to placement cell
icount = icount + 1
Rows(i).EntireRow.Copy
rPlacementCell.PasteSpecial xlPasteValuesAndNumberFormats
Range("D2").Copy
rPlacementCell.PasteSpecial xlPasteValues
Set rPlacementCell = rPlacementCell.Offset(1)
End If
Next i
End If
Next Worksheet
Worksheets("collect_tool").Activate
Range("B3").Activate
End If
End Sub
This code works for me:
Sub request_task_list()
Dim rPlacementCell As Range
Dim myValue As Variant
Dim i As Integer
Dim wrkBk As Workbook
Dim wrkSht As Worksheet
Set wrkBk = ActiveWorkbook
'or
'Set wrkBk = ThisWorkbook
'or
'Set wrkBk = Workbooks.Open("C:/abc/def/hij.xlsx")
myValue = InputBox("Please enter the Name (Name or Surname) of the Person whos task you are looking for", "Input", "Hansen")
If myValue <> "" Then
Set rPlacementCell = wrkBk.Worksheets("Collect_tool").Range("A3") 'Be specific about which workbook the sheet is in.
For Each wrkSht In wrkBk.Worksheets
'Only process if the sheet name starts with 'E'
If Left(wrkSht.Name, 1) = "E" Then
For i = 17 To 50
'Cells(i,4) is the same as Range("D" & i) - easier to work with numbers than letters in code.
If InStr(1, LCase(wrkSht.Cells(i, 4)), LCase(myValue)) > 0 Then 'Be specific about which sheet the range is on.
'In string search for input value from msg. box
'Copy the whole row if found to placement cell
wrkSht.Rows(i).EntireRow.Copy
rPlacementCell.PasteSpecial xlPasteValuesAndNumberFormats
rPlacementCell.Value = wrkSht.Cells(2, 4).Value
Set rPlacementCell = rPlacementCell.Offset(1)
End If
Next i
End If
Next wrkSht
Worksheets("collect_tool").Activate
Range("B3").Activate
End If
End Sub
I'm guessing your code failed at this point: For Each Worksheet In ActiveWorkbook.Worksheets. Worksheet is a member of the Worksheets collection and I don't think it can be used this way. Note in my code I've set wrkSht as a Worksheet object and then used wrkSht to reference the current worksheet in the loop.

VBA Script to Fill Cell into List Below and Repeat

I have a spreadsheet that list a Case Manager and then list the students below it. Then it lists another Case Manager and students below it. I want to copy the Case Manager Name from the top of each list to the end of the row of respective students underneath, repeating with each Case Manager until I get to the end of my sheet. The number of Case Managers and students can vary.
I have the following code to do the first Case Manager but not sure how to loop it of if there is a better solution. I want all the data to stay in the original spot.
Original Source: (Imported Text File)
Modified Source: (After Macro is Run)
Sub CMWizard()
Dim CMName As String
Dim StopRow As Long
Dim r As Long
CMName = Range("A1").Value 'Get the Case Manager Name.
StopRow = Range("B2").End(xlDown).Row 'Get first blank cell in Column B.
For r = 2 To StopRow 'Start at Row 2 and continue until you reach the StopRow.
Cells(r, 6).Value = CMName 'Set every cell from Row 2 in Column F (6) to the Case Manager Name.
End Sub
Let's say your Excel file looks like this
Paste this code in a module. I have commented the code so that you will not have a problem understanding it.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim i As Long, LRow As Long, R As Long
Dim CM As String
Dim delRng As Range
Application.ScreenUpdating = False
'~~> Replace Sheet 1 with the relevant sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Get last row of Col A
LRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Loop through cells in Col A
For i = 1 To LRow
'~~> Check if the cell contains "Case Manager"
If InStr(1, .Cells(i, 1).Value, "Case Manager", vbTextCompare) Then
'~~> Store the Case manager's name in a variable
CM = .Cells(i, 1).Value
'~~> Store the row numbers which have "Case Manager"
'~~> We will delete it later
If delRng Is Nothing Then
Set delRng = .Rows(i)
Else
Set delRng = Union(delRng, .Rows(i))
End If
Else
'~~> Store the Case manager in Col F
.Cells(i, 6).Value = CM
End If
Next i
End With
'~~> Delete the rows which have "Case Manager"
If Not delRng Is Nothing Then delRng.Delete
Application.ScreenUpdating = True
End Sub
Output
i think you are just missing an next
Sub CMWizard()
Dim CMName As String
Dim StopRow As Long
Dim r As Long
CMName = Range("A1").Value 'Get the Case Manager Name.
StopRow = Range("B2").End(xlDown).Row 'Get first blank cell in Column B.
For r = 2 To StopRow 'Start at Row 2 and continue until you reach the StopRow.
Cells(r, 6).Value = CMName 'Set every cell from Row 2 in Column F (6) to the Case Manager Name.
Next
End Sub
just be aware that StopRow = Range("B2").End(xlDown).Row will return last row in worksheet if there are just empty cells below ("B2")
Hope it helps

Best way to get the last non-empty worksheet

I'm trying to write a vba macro for a group tha
has one workbook where they daily create new worksheets, and also have
Sheet 1, Sheet 2 and Sheet 3 at the end of their long list of sheets.
I need to create a external cell reference in a new column in a different workbook where this information is being summarized.
So I need to know how to get the last non-empty sheet so I can grab this data and place it appropriately in the summary.
This function works through the sheets from right to left until it finds a non-blank sheet, and returns its name
Function GetLastNonEmptySheetName() As String
Dim i As Long
For i = Worksheets.Count To 1 Step -1
If Sheets(i).UsedRange.Cells.Count > 1 Then
GetLastNonEmptySheetName = Sheets(i).Name
Exit Function
End If
Next i
End Function
The method above will ignore a sheet with a single cell entry, while that may seem to be a quibble, a Find looking for a non-blank cell will give more certainty.
The xlFormulas argument in the Find method will find hidden cells (but not filtered cells) whereas xlValues won't.
Sub FindLastSht()
Dim lngCnt As Long
Dim rng1 As Range
Dim strSht As String
With ActiveWorkbook
For lngCnt = .Worksheets.Count To 1 Step -1
Set rng1 = .Sheets(lngCnt).Cells.Find("*", , xlFormulas)
If Not rng1 Is Nothing Then
strSht = .Sheets(lngCnt).Name
Exit For
End If
Next lngCnt
If Len(strSht) > 0 Then
MsgBox "Last used sheet in " & .Name & " is " & strSht
Else
MsgBox "No data is contained in " & .Name
End If
End With
End Sub