I currently have the following codes that look up the column for Columbus. But how do I specify that I only want to look up the column for Columbus in Ohio by also referring to row 4 (State)?
Amount = WorksheetFunction.Match("Columbus", Rows("5:5"), 0)
Try Looping thru all the records -
Dim Amount As Variant
Dim lngRow as long
lngRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lngRow 'Considering row 1 has headers
If ActiveSheet.Cells(i, 5) = "Columbus" And ActiveSheet.Cells(i, 4) = "Ohio" Then
Amount = i
Exit For
End If
Next i
Thanks
Use Variant Arrays and cycle through that it will be quicker:
With Worksheets("Sheet1") 'Change to your sheet
Dim rngArr() As Variant
rngArr = .Range(.Cells(4, 1), .Cells(5, .Columns.Count).End(xlToLeft)).Value
Dim i As Long
For i = 1 To UBound(rngArr, 2)
If rngArr(1, i) = "Ohio" And rngArr(2, i) = "Columbus" Then Exit For
Next i
If i <= UBound(rngArr, 2) Then
Dim Amount As Long
Amount = i
Else
MsgBox "Not Found"
End If
End With
Related
I'm writing a code to loop through an excel sheet and changing the text (in column B) to uppercase/lowercase, depending on the value of cell in column N on the same row.
Macros purpose:
loop through cells in column B starting at row 2 and changing the string from upper to lowercase or vice versa, depending on the value of the cell in column N (lowercase if value = 5, other cases text should be uppercase)
Code I've got so far:
Sub CAPS()
'
' CAPS Macro
'
Dim Rang As Integer
Dim j As Integer
j = 2
For Each N In Source.Range("N2:N10000") ' Do 10000 rows
Rang = Cells(j, 14)
If Rang = 5 Then
Cells(j, 2).Range("A1").Select
ActiveCell.Value = LCase$(ActiveCell.Text)
Else
ActiveCell.Value = UCase$(ActiveCell.Text)
j = j + 1
End If
Next N
End Sub
I'm a little bit stuck in the looping part, not really a clue how to fix the error(s) in the current code.
Thanks in advance :)
Sub CAPS()
'
' CAPS Macro
'
Dim N as long 'use long here as integer is limite to a 32b character
For N Is 2 to 10000 ' Do 10000 rows
If Cells(N, 14) = 5 Then
Cells(N, 2) = LCase(Cells(N,2)
Else
Cells(N, 2) = UCase(Cells(N,2)
EndIf
Next N
End Sub
This should do the trick, untested though.
You currently have a fixed number of rows you want to test. To optimize your code you could first check how many rows are filled with data. To do so you can use:
DIM lastrow as long
lastrow = Cells(Rows.Count, "B").End(xlUp).Row
And then make the loop with For N Is 2 to lastrow
Also it is good practice to explicitly reference your worksheets, as this prevents undesired results. For example you click on another worksheet whilst the code is running it will continue formatting on that sheet. To do so declare a variable as your worksheet:
DIM ws as worksheet
And set a value to your variable, in this case Sheet1.
Set ws as ThisWorkbook.Worksheets("Sheet1")
Now every time you reference a Cells(), you explicitly say on what sheet that has to be by adding ws. in front of it like such: ws.Cells()
To summarize all that into your code:
Sub CAPS()
'
' CAPS Macro
'
Dim N as long 'use long here as integer is limite to a 32b character
Dim lastrow as long
Dim ws as worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'Set the code to run on Sheet 1 of your current workbook.
lastrow = ws.Cells(Rows.Count, "B").End(xlUp).Row
For N Is 2 to lastrow ' Do all rows that have data in column B
If ws.Cells(N, 14) = 5 Then
ws.Cells(N, 2) = LCase(ws.Cells(N,2)
Else
ws.Cells(N, 2) = UCase(ws.Cells(N,2)
EndIf
Next N
End Sub
Try processing in an array,
Sub CAPS()
'
' CAPS Macro
'
Dim arr As variant, j As Integer
with worksheets("sheet1")
arr = .range(.cells(2, "B"), .cells(.rows.count, "B").end(xlup).offset(0, 12)).value2
for j= lbound(arr, 1) to ubound(arr, 1)
if arr(j, 13) = 5 then
arr(j, 1) = lcase(arr(j, 1))
else
arr(j, 1) = ucase(arr(j, 1))
end if
next j
redim preserve arr(lbound(arr, 1) to ubound(arr, 1), 1 to 1)
.cells(2, "B").resize(ubound(arr, 1), ubound(arr, 2)) = arr
end with
End Sub
You may try something like this...
Sub CAPS()
Dim ws As Worksheet
Dim lr As Long, i As Long
Application.ScreenUpdating = False
Set ws = Sheets("Sheet1") 'Sheet where you have to change the letter case
lr = ws.Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To lr
Select Case ws.Cells(i, "N")
Case 5
ws.Cells(i, "B") = LCase(ws.Cells(i, "B"))
Case Else
ws.Cells(i, "B") = UCase(ws.Cells(i, "B"))
End Select
Next i
Application.ScreenUpdating = True
End Sub
Another approach using for each loop with Range:
Sub UCaseLCase()
Dim rng, cell As Range
Dim Test As Integer
Test = 5
Set rng = Range(Cells(2, 14), Cells(10000, 14))
For Each cell In rng.Cells
If cell.Value = Test Then
cell.Offset(0, -12) = LCase(cell.Offset(0, -12))
Else
cell.Offset(0, -12) = UCase(cell.Offset(0, -12))
End If
Next cell
End Sub
I know you said in your question starting at row 2 but it's easier just going from last row until row 2.
Hope this can help or at least, learn something new about Loops :)
Sub CAPS()
Dim j As Integer
For j = Range("B2").End(xlDown).Row To 2 Step -1
If Range("N" & j).Value = 5 Then
'uppercase
Range("B" & j).Value = UCase(Range("B" & j).Value)
Else
'lowercase
Range("B" & j).Value = LCase(Range("B" & j).Value)
End If
Next j
End Sub
the code below works fine apart from one thing, the names are copied to the second sheet in the same position as they are in in the first sheet so I end up with this.
As you can see there are loads of blanks, what I need it to end up like is,
This
There are three parts to the code as you can see
1 gather names and status
2 test the availability of the person and write their name to the second sheet if they are available
3 clear out the blanks
Is there any way I can amend the line;
Activecell.offset to place the name in the next available cell in each column as it cycles through?
I can’t use the “clear the blanks” as it screws up all the buttons positions in the second sheet
Code
Option Explicit
Sub Copy_all_available_names_to_sorted_sidesmen_50()
'record all the names and availability into a single array
Dim AllData() As Variant
Dim Name As Long, Status As Long
Dim Storedname As String
Dim Storedstatus As String
Dim nameindex As Long
Sheets("Everyones Availability").Select
Name = Range("A3", Range("A3").End(xlDown)).Count - 1
Status = Range("a3", Range("a3").End(xlToRight)).Count - 1
ReDim AllData(0 To Name, 0 To Status)
For Name = LBound(AllData, 1) To UBound(AllData, 1)
For Status = LBound(AllData, 2) To UBound(AllData, 2)
AllData(Name, Status) = Range("A3").Offset(Name, Status).Value
Next Status
Next Name
Sheets("Sorted sidesmen").Select
Range("A3").Select
For Name = LBound(AllData, 1) To UBound(AllData, 1)
For Status = LBound(AllData, 2) To UBound(AllData, 2)
Storedname = AllData(Name, 0)
Storedstatus = AllData(Name, Status)
If Storedstatus = "Available" Then
ActiveCell.Offset(1, 0)(Name, Status).Value = Storedname
End If
Next Status
Next Name
Dim rng As Range
On Error GoTo NoBlanksFound
Set rng = Range("a3:z46").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
rng.Rows.Delete shift:=xlShiftUp
NoBlanksFound:
MsgBox "All Blanks have been removed"
End Sub
Thank you for looking and help you may be able to give
This should work
Option Explicit
Public Sub CopyAllAvailableNamesToSortedSidesmen50()
Dim wsEA As Worksheet: Set wsEA = ThisWorkbook.Worksheets("Everyones Availability")
Dim wsSS As Worksheet: Set wsSS = ThisWorkbook.Worksheets("Sorted sidesmen")
Dim topEAcel As Range: Set topEAcel = wsEA.Cells(3, "A")
Dim topSScel As Range: Set topSScel = wsSS.Cells(3, "A")
Dim lrEA As Long: lrEA = wsEA.Cells(wsEA.Rows.Count, "A").End(xlUp).Row
Dim lcEA As Long: lcEA = wsEA.Cells(1, wsEA.Columns.Count).End(xlToLeft).Column
wsSS.Range(topSScel, wsSS.Cells(lrEA, lcEA)).ClearContents 'clear Sorted sidesmen
Dim arrEA As Variant: arrEA = wsEA.Range(topEAcel, wsEA.Cells(lrEA, lcEA))
Dim arrSS As Variant: arrSS = wsSS.Range(topSScel, wsSS.Cells(lrEA, lcEA))
Dim rEA As Long, cEA As Long, rSS As Long
For cEA = 2 To lcEA 'by columns
rSS = 1
For rEA = 1 To lrEA - 2 'by rows
If arrEA(rEA, cEA) = "Available" Then
arrSS(rSS, cEA) = arrEA(rEA, 1) 'copy available names
rSS = rSS + 1
End If
Next
Next
wsSS.Range(topSScel, wsSS.Cells(lrEA, lcEA)).Value2 = arrSS 'paste in wsSS
End Sub
Sheet1 ("Everyones Availability")
Sheet2 ("Sorted sidesmen")
Key items in code:
Last Row on "Everyones Availability": lrEA
Last Col on "Everyones Availability": lcEA
lrEA = wsEA.Cells(wsEA.Rows.Count, "A").End(xlUp).Row
lcEA = wsEA.Cells(1, wsEA.Columns.Count).End(xlToLeft).Column
Note: initial methods (xlDown, and xlToRight) were causing issues with empty cells
- All data on "Everyones Availability": arrEA = Variant Array (copy from)
- All data on "Sorted Sidesmen": arrSS = Variant Array (copy to; empty before copy)
arrEA = wsEA.Range(topEAcel, wsEA.Cells(lrEA, lcEA))
arrSS = wsSS.Range(topSScel, wsSS.Cells(lrEA, lcEA)) 'Same size as arrEA
If arrEA(rEA, cEA) = "Available" Then
arrSS(rSS, cEA) = arrEA(rEA, 1) 'copy names
rSS = rSS + 1 'separate row counter for "Sorted sidesmen", increment only if "Available"
End If
Could you simply sort the output in the final sheet?
Option Explicit
Public Sub Ordering()
Dim col As Range, lastRow As Long
With ThisWorkbook.Worksheets("Sheet1") 'change as appropriate
lastRow = .UsedRange.SpecialCells(xlLastCell).Row
For Each col In Intersect(Range("A:D"), .UsedRange).Columns
.Range(.Cells(3, col.Column), .Cells(lastRow, col.Column)).Sort Key1:=.Range(.Cells(3, col.Column), .Cells(lastRow, col.Column)), Order1:=xlAscending, Header:=xlNo ' 'Sort to ensure in order
Next col
End With
End Sub
Before:
After:
This code should do what you need:
Assuming your source sheet is called "Everyones Availability" and new sheet "Sorted sidesmen"
Sub copy_to_newsheet()
Dim i, j, lr, lc, newlr, newlc As Long
Sheets("Sorted sidesmen").Cells.ClearContents
lr = Sheets("Everyones Availability").Range("A10000").End(xlUp).Row '' your last row
lc = Sheets("Everyones Availability").Range("A1").End(xlToRight).Column '' your last column
Sheets("Everyones Availability").Range(Cells(1, 1), Cells(2, lc)).Copy
Sheets("Sorted sidesmen").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
For j = 1 To lc
For i = 3 To lr
Sheets("Sorted sidesmen").Select
Cells(1, j).Select
newlr = Selection.End(xlDown).Row '' your new last row
newlc = Selection.End(xlToRight).Column '' your new last column
If Sheets("Everyones Availability").Cells(i, j).Value = "" Then GoTo thenexti
Sheets("Everyones Availability").Cells(i, j).Copy
Sheets("Sorted sidesmen").Cells(newlr + 1, j).PasteSpecial Paste:=xlPasteValues
thenexti:
Next
Next
End Sub
I'm trying to remove the blank records from a combobox with two lists.
This is my code:
Private Sub UserForm_Initialize()
Dim N As Range
Dim LastRow As Integer
Dim ws As Worksheet
PREST.ColumnCount = 2
Set ws = Worksheets("L_Location")
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Dim i, j As Integer
Dim location(2 To 100, 1 To 2) As String
For j = 1 To 2
For i = 2 To LastRow
If ws.Cells(i, j).Value <> vbNullString Then
location(i, j) = ws.Cells(i, j).Value
End If
Next i
Next j
PREST.List = location
End Sub
I don't know what I'm doing wrong.
You are having blanks because your 2D array is already sized with 100 rows. A simple workaround would be to first count the non-empty rows, then dimension the Array accordingly.
Dim location() As String
Dim count As Long
count = Range("A2:A" & LastRow).SpecialCells(xlCellTypeConstants).Cells.count
ReDim location(1 To count, 1 To 2)
'then continue from here to fill the array
This code will fill the combobox with your range value then will delete any empty item:
Private Sub UserForm_Initialize()
Dim LastRow As Long
Dim ws As Worksheet
PREST.ColumnCount = 2
Set ws = Worksheets("L_Location")
LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Dim i As Long ', j As Integer
PREST.List = ws.Range("a1:b" & LastRow).Value
For i = PREST.ListCount - 1 To 0 Step -1
If PREST.List(i) = "" Then PREST.RemoveItem i
Next
End Sub
I tried this :
Dim location() As String
ReDim location(LastRow - 2, 1)
For j = 0 To 1
For i = 0 To LastRow - 2
If ws.Cells(i + 2, j + 1).Value <> vbNullString And ws.Cells(i + 2, j + 1).Value <> "" Then
location(i, j) = ws.Cells(i + 2, j + 1).Value
End If
Next i
Next j
PREST.List = location
which seems to work but i guess its gonna give me an error if the list is empty (lastrow = 1)
Since you say that any two cells on the same row are both either blank or with values, then you could go like follows:
Dim cell As Range
Dim i As Long, j As Long
PREST.ColumnCount = 2
With Worksheets("L_Location") '<--| reference your worksheet
With .Range("A2", .Cells(.Rows.Count,1).End(xlUp)).SpecialCells(xlCellTypeConstants) '<--| reference its column A not empty cells from row 1 down to last not empty one
Dim location(1 To .Count, 1 To 2) As String '<--| size your array rows number to that of referenced cells
For Each cell In .Cells '<--| loop through referenced cells
i = i + 1 '<--| update array row index
For j = 1 To 2 '<--| loop through array columns
location(i, j) = cell.Offset(j -1).Value '<--| fill array
Next j
Next cell
End With
End With
PREST.List = location
I have this code in one of the part of my script count the data from Column A if the data have duplicate value for 3 consecutive months it will be tag as "Selected" and "Updated"
Output would be like this:
Column A | Column B | Column C | Column D |
243899 | 1/20/2016 | | |
243899 | 2/10/2016 | | |
243899 | 3/15/2016 | Selected | Updated |
Note:
Column B is where the month value
Column C and D is where the data will be tag as "Selected" and "Updated"
I have 3 months of data
My problem is that i'm going to change all the target Column in the example above
Column A to Column T
Column B to Column BS
Column C and D to Column CH and CI
My code:
Public Sub Selection()
Dim file2 As Excel.Workbook
Dim Sheet2 As Worksheet, data(), i&
Dim myRangeColor As Variant, myRangeMonthValue
Dim MstrSht As Worksheet
Dim DataArr As Variant
Dim ColorArr As Variant
Dim MonthCol As Collection
Dim CloseToDate As Date
Dim MaxDate As Date
Dim c As Long
Set Sheet2 = Workbooks.Open(TextBox2.Text).Sheets(1)
'Load Data into Array
DataArr = Sheet2.Range("A2:D" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)
Find distinct colors
ColorArr = ReturnDistinct(Sheet2.Range("A2:A" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row))
Remove any values in the arrays third column
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
DataArr(i, 4) = ""
Next i
'Loop Each Color
For c = LBound(ColorArr) To UBound(ColorArr)
Set MonthCol = New Collection
MaxDate = 0
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = ColorArr(c) Then
'Load the colors months into a collection
On Error Resume Next
MonthCol.Add Month(DataArr(i, 2)), CStr(Month(DataArr(i, 2)))
On Error GoTo 0
'Find Max Date
If DataArr(i, 2) Then
MaxDate = Application.WorksheetFunction.Max(MaxDate, DataArr(i, 2))
End If
End If
Next i
'If the color were found in three or more seperate months then the row with date closest to CloseToDate gets flagged
If MonthCol.Count > 2 Then
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = ColorArr(c) And DataArr(i, 2) = MaxDate Then
DataArr(i, 3) = "Selected"
DataArr(i, 4) = "Updated"
End If
Next i
End If
Next c
'Print results to sheet
Sheet2.Range("A2:D" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row) = DataArr
End Sub
Function ReturnDistinct(InpRng As Range) As Variant
Dim Cell As Range
Dim i As Integer
Dim DistCol As New Collection
Dim DistArr()
'Add all values to collection
For Each Cell In InpRng
On Error Resume Next
DistCol.Add Cell.Value, CStr(Cell.Value)
On Error GoTo 0
Next Cell
'Write collection to array
ReDim DistArr(1 To DistCol.Count)
For i = 1 To DistCol.Count Step 1
DistArr(i) = DistCol.Item(i)
Next i
ReturnDistinct = DistArr
End Function
I got my code here so im not really familiar to this code.. Is it possible to change the column in my script? I've done lots of trial and error on this one i can't seem to figure it out,. Any help, tips or suggestion i would gladly appreciate it!
In my previous comment, I had something in mind as follows. I tested this using columns A,B,C,D, but not using the more widely dispersed columns.
As a side note, I also had some trouble with your WorksheetFunction.Max call - I had to use CDate to get the comparison to work.
Public Sub Selection()
Dim file2 As Excel.Workbook
Dim Sheet2 As Worksheet, data(), i&
Dim myRangeColor As Variant, myRangeMonthValue
Dim MstrSht As Worksheet
Dim DataArr() As Variant
Dim TempArr1 As Variant, TempArr2 As Variant
Dim TempArr3 As Variant, TempArr4 As Variant
Dim ColorArr As Variant
Dim MonthCol As Collection
Dim CloseToDate As Date
Dim MaxDate As Date
Dim c As Long
Dim nRows As Long, nCols As Long
Dim iLoop As Long
' Set Sheet2 = Workbooks.Open(TextBox2.Text).Sheets(1)
Set Sheet2 = Sheets("Sheet2")
'Load Data into Array
' DataArr = Sheet2.Range("A2:D" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)
TempArr1 = Sheet2.Range("T2:T" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)
TempArr2 = Sheet2.Range("BS2:BS" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)
TempArr3 = Sheet2.Range("CH2:CH" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)
TempArr4 = Sheet2.Range("CI2:CI" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)
nRows = UBound(TempArr1)
nCols = 4
ReDim Preserve DataArr(1 To nRows, 1 To nCols)
For iLoop = 1 To nRows - 1
DataArr(iLoop, 1) = TempArr1(iLoop, 1)
DataArr(iLoop, 2) = TempArr2(iLoop, 1)
DataArr(iLoop, 3) = TempArr3(iLoop, 1)
DataArr(iLoop, 4) = TempArr4(iLoop, 1)
Next iLoop
'Find distinct colors
ColorArr = ReturnDistinct(Sheet2.Range("A2:A" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row))
'Remove any values in the arrays third column
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
DataArr(i, 3) = ""
Next i
'Loop Each Color
For c = LBound(ColorArr) To UBound(ColorArr)
Set MonthCol = New Collection
MaxDate = 0
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = ColorArr(c) Then
'Load the colors months into a collection
On Error Resume Next
MonthCol.Add Month(DataArr(i, 2)), CStr(Month(DataArr(i, 2)))
On Error GoTo 0
'Find Max Date
If DataArr(i, 2) > 0 Then
MaxDate = Application.WorksheetFunction.Max(CDate(MaxDate), CDate(DataArr(i, 2)))
End If
End If
Next i
'If the color were found in three or more seperate months then the row with date closest to CloseToDate gets flagged
If MonthCol.Count > 2 Then
For i = LBound(DataArr, 1) To UBound(DataArr, 1)
If DataArr(i, 1) = ColorArr(c) And DataArr(i, 2) = MaxDate Then
DataArr(i, 3) = "Selected"
DataArr(i, 4) = "Updated"
End If
Next i
End If
Next c
'Print results to sheet
'Sheet2.Range("A2:D" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row) = DataArr
For iLoop = 1 To nRows - 1
TempArr1(iLoop, 1) = DataArr(iLoop, 1)
TempArr2(iLoop, 1) = DataArr(iLoop, 2)
TempArr3(iLoop, 1) = DataArr(iLoop, 3)
TempArr4(iLoop, 1) = DataArr(iLoop, 4)
Next iLoop
Sheet2.Range("T2:" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row).Value2 = TempArr1
Sheet2.Range("BS2:BS" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row).Value2 = TempArr2
Sheet2.Range("CH2:CH" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row).Value2 = TempArr3
Sheet2.Range("CI2:CI" & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row).Value2 = TempArr3
End Sub
I really need some help.
Problem: I have a workbook with 2 worksheets. Both sheets has headers. Sheet1 is a list of account numbers in column A and the same for sheet 2 column A. Now, what I need to do is this:
if I place a date in column AI in sheet 2 for a specific account number, then find the corresponding account number in sheet 1 and place the word "Complete" in column Y for that account.
I hope I explained this enough. Below is what I came up with so far, but got stuck:
Sub UpdateTBP()
Dim i
Dim j
Dim k
Dim LastRow
Dim LastRow2
LastRow = Sheets("Portfolio").Cells(Rows.Count, 1).End(xlUp).Row
LastRow2 = Sheets("TBP").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To (LastRow - 1)
For j = 2 To (LastRow2 - 1)
If Sheets("Portfolio").Cells(i, 1) = Sheets("TBP").Cells(j, 1).value Then
For k = 35 To 35
If Sheets("TBP").Cells(j, 35) <> "" Then
Sheets("Portfolio").Cells(i, Y).value = "Complete"
End If
Next
End If
Next
Next
ThisWorkbook.Save
End Sub
I was able to make it work by using the following modified code:
Sub UpdateTBP()
Dim i
Dim j
Dim k
Dim LastRow
Dim LastRow2
LastRow = Sheets("Portfolio").Cells(Rows.Count, 1).End(xlUp).Row
LastRow2 = Sheets("TBP").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To (LastRow - 1)
For j = 2 To (LastRow2 - 1)
If Sheets("Portfolio").Cells(i, 1).Value = Sheets("TBP").Cells(j, 1).Value Then
If Sheets("TBP").Cells(j, 35) <> "" Then
Sheets("Portfolio").Cells(i, 25).Value = "Complete"
End If
End If
Next
Next
ThisWorkbook.Save
End Sub
Please note that this will not include your last row of data as you have subtracted it out with:
For i = 2 To (LastRow - 1)
For j = 2 To (LastRow2 - 1)
If you wish to include that last row, just use the following:
For i = 2 to LastRow
For j = 2 to LastRow2
This includeds the previous comments I made. I just gave it a quick test and it is working.