Sorry I am new to VBA. The Vlookup calls for Column X & Y work fine. However, for column Z, I am trying to count the number of names in Column B, but an error kept popping up. I wonder why?
Dim lastrow As Long
lastrow = Range("A2").End(xlDown).Row
Range("X2:X" & lastrow).FormulaR1C1 = "=VLOOKUP(RC[-23],'Sheet2'!R1C1:R25000C10,7,0)"
Range("Y2:Y" & lastrow).FormulaR1C1 = "=VLOOKUP(RC[-24],'Sheet2'!R1C1:R25000C10,2,0)"
Range("Z2:Z" & lastrow).FormulaR1C1 = "=LEN(RC[-22]-LEN(SUBSTITUTE(RC[-22], "";"", ""))+1"
Columns("X:Z").EntireColumn.AutoFit
Basically, what I am try to achieve is like the following. Column Z will autofill the occurrences of names in column B
I think you are missing a parenthese in your function string, as well as escape quotes for the empty string, so it should be:
Range("Z2:Z" & lastrow).FormulaR1C1 = "=LEN(RC[-22])-LEN(SUBSTITUTE(RC[-22], "";"", """"))+1"
I realize that this answer doesn't answer your question but at least the following code serve the same purpose. And to fix the problem if there are blanks or merged cells in the range as pointed out by Mr. RGA, I change the way to formulate variable Last_Row
Sub Count_Name()
Dim i As Long, Last_Row As Long
With Sheets("Sheet1")
'It won't be a problem anymore if there are blanks or merged cells in the range using this line
Last_Row = Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To Last_Row
If .Cells(i, "A") = "" Then
.Cells(i, "B") = 0
Else
.Cells(i, "B") = Len(.Cells(i, "A")) - Len(Replace(.Cells(i, "A"), ";", "")) + 1
End If
Next i
End With
End Sub
Here I'm assuming the string names are in column A, the number of names are in column B, and both of the data are in Sheet1. The equivalent Excel formula for the above code is
=LEN(A2) - LEN(SUBSTITUTE(A2, ";", "")) + 1
Related
Gods of VBA,
I would like to request your help on some code i can't seem to get working straight.
Purpose,
When a row has a cell Value "x" on row A in sheet 'Dump', i would like to past certain values in Sheet 'test'.
The values that need to be posted on Sheet 'test', are in column B, D, F and L.
Value from column B, Sheet 'Dump' should go to D4, in sheet 'test'.
Value from column D, Sheet 'Dump' should go to C4, in Sheet 'test'.
Value from column F, Sheet 'Dump' should go to A4, in Sheet 'test'.
Value from column L, Sheet 'Dump' should go to E4, in Sheet 'test'.
Ofcourse i'm trying to make the VBA loop as that when multiple rows on Sheet 'Dump' contains the character 'x', it continues from D/C/A/E4 to the next row.
The code I already have working is posted here:
Sub test()
Dim i, LastRow
LastRow = Sheets("Dump").Range("A" & Rows.Count).End(xlUp).Row
Sheets("test").Range("A2:K200").ClearContents
For i = 2 To LastRow
If Sheets("Dump").Cells(i, "A").Value = "x" Then
Sheets("Dump").Range(Cells(i, "B"), Cells(i, "B")).Copy
Destination:=Sheets("test").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End Sub
Have been trying with a lot of different sources of VBA, and some tweaking to it. If i started with a wrong source, or am making some n00b-mistakes, please direct me to what i did wrong. Just trying to learn, while coding.
Tim posted the better way to copy values only but here is what is the problem with your code:
The syntax for copying is
sourceRange.Copy Destination:=destinationRange
The := specifies an option/paramter to the .Copy method. It can be confusing because there are no parentheses around the arguments like you could expect from other languages.
someMethod(argument1, argument2)
would be
someMethod argument1, argument2
if there is nothing else in the line (otherwise you need parentheses).
You can specify what argument you use by naming it and using :=. This is especially useful for optional arguments or to keep your code readable (you might not remember what each argument is in a few months). Some people keep parameters empty but I think it's obvious why something like
someMethod paramName1:=True, paramName4:=False, paramName5:=True
is easier to read than
someMethod True, , , False, True
(I am assuming the parameter names are descriptive like Destination).
The parameters of a function need to be in the same row as the function. To concatenate the rows, remove the linebreak (duh) or place an _ at the end of the line (if it get's to long).
Example with parentheses and linebreaks:
Set someRange = rangeToSearch.Find( _
What:="abc", _
LookIn:=xlValues, _
MatchCase:=True)
Example without parenthesis and linebreaks:
destinationRange.PasteSpecial Paste:=xlPasteValues, skipblanks:=True
You could try the following.
Sub test()
Dim i, LastRow
LastRow = Sheets("Dump").Range("A" & Rows.Count).End(xlUp).Row
Sheets("test").Range("A2:K200").ClearContents
j = 4
For i = 2 To LastRow
If Sheets("Dump").Cells(i, "A").Value = "x" Then
Sheets("test").Cells(j, 4) = Sheets("Dump").Cells(i, 2).Value
Sheets("test").Cells(j, 3) = Sheets("Dump").Cells(i, 3).Value
Sheets("test").Cells(j, 1) = Sheets("Dump").Cells(i, 6).Value
Sheets("test").Cells(j, 5) = Sheets("Dump").Cells(i, 12).Value
j = j + 1
End If
Next i
End Sub
You need a separate way of tracking each row in the test sheet, hence adding j = 4 (because you want to start on row 4).
EDIT
I would define your sheets if you call them a a lot.
Sub test()
Dim i, LastRow, source as Worksheet, dest as Worksheet
Set source = ActiveWorkbook.Sheets("Dump")
Set dest = ActiveWorkbook.Sheets("test")
LastRow = source.Range("A" & Rows.Count).End(xlUp).Row
dest.Range("A2:K200").ClearContents
j = 4
For i = 2 To LastRow
With source
If .Cells(i, "A").Value = "x" Then
dest.Cells(j, 4) = .Cells(i, 2).Value
dest.Cells(j, 3) = .Cells(i, 3).Value
dest.Cells(j, 1) = .Cells(i, 6).Value
dest.Cells(j, 5) = .Cells(i, 12).Value
j = j + 1
End If
End With
Next i
End Sub
I have a small macro which takes data from multiple xml files and pastes in xlsm. Each xml file has a tag name, and the column the data pastes into has the tag name in row 4. I'm trying to paste into one below the last used row, but the three methods I have below keep returning "1" for the last used row.
Asterisks is the code I'm having trouble with.
For Z = 1 To 16
If Cells(4, Z).Value Like i Then
Dim Lengthend As Double
Dim An As Variant
An = (Split(Cells(4, Z).Address(True, False), "$")(0))
Lengthend = *****
Cells(Lengthend + 1, Z).Select
Cells(Lengthend + 1, Z).PasteSpecial Paste:=xlPasteValues
End If
Next
Here are the three methods I used to find the end of the column:
Dim sht As Worksheet
Set sht = Sheets("PI Data")
sht.Cells(sht.Rows.Count, "An").End(xlUp).Row
And
Lengthend = Range("An" & Rows.Count).End(xlUp).Row
And
(ActiveSheet.UsedRange.Columns(An).Count)
Each of these methods returns the answer "1." Any advice on what I'm doing wrong?
Lengthend = Range("An" & Rows.Count).End(xlUp).Row
The above has a typo and works if you change it to - what you propably tried to do is pass the value of variable An and not value "An"
Lengthend = Range(An & Rows.Count).End(xlUp).Row
You should also define the worksheet you are referring to to avoid any further problems -
Lengthend = Sheets("PI Data").Range(An & Rows.Count).End(xlUp).Row
I'm quite new at VBA. I've used it in excel for a couple macros, but this one is way above my head.
I'm looking to create a macro that will find the appropriate column, then based on the value in this columns, changes the values in three other columns. I already have a static macro:
Sub AdjustForNoIntent()
'Adjusts columns Role(U) (to C-MEM), REV Profile Follow-up Date(AJ) (to N/A) and deletes Follow-up Date(Y) when column Survey: Intent to Participate = No
Dim lastrow As Long
Dim i As Long
lastrow = Range("AE" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Not IsError(Range("AE" & i).Value) Then
If Range("AE" & i).Value = "No" And Range("U" & i).Value = "MEM" Then
Range("U" & i).Value = "C-MEM"
Range("Y" & i).ClearContents
Range("AJ" & i).Value = "N/A"
ElseIf Range("AE" & i).Value = "No" And Range("U" & i).Value = "VCH" Then
Range("U" & i).Value = "C-VCH"
Range("Y" & i).ClearContents
Range("AJ" & i).Value = "N/A"
End If
End If
Next i
End Sub
But this is a shared workbook, so people are adding columns randomly and every time I need to go back to the code and modify the columns refereces. What I want is, for instance, to look for column with "Role" header in row A3 and to insert it where the macro looks for column "U". That way other users can add/delete columns but I won't have to modify the macro every time.
In other macros, I manage to have this thing working:
Function fnColumnNumberToLetter(ByVal ColumnNumber As Integer)
fnColumnNumberToLetter = Replace(Replace(Cells(1,ColumnNumber).Address, "1", ""), "$", "")
End Function
Dim rngColumn As Range
Dim ColNumber As Integer
Dim ColName As String
ColName = "Email Address"
Sheets("Tracking").Select
Set rngColumn = Range("3:3").Find(ColName)
ColNumber = Sheets("Tracking").Range(rngColumn, rngColumn).Column
Sheets("Combined").Range(ActiveCell, "W2").FormulaLocal = "=IF(ISERROR(INDEX(Tracking!$A:$A,MATCH(O:O,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0))), INDEX(Tracking!$A:$A,MATCH(U:U,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0)), INDEX(Tracking!$A:$A,MATCH(O:O,Tracking!" & fnColumnNumberToLetter(ColNumber) & ":" & fnColumnNumberToLetter(ColNumber) & ",0)))"
However, I am unable to link the latter to the first and much less to get it to find multiple columns. Any help is appreciated.
EDIT:
Following suggestions, here is the new code. Doesn't return an error, but doesn't do anything either. It loops through the c loop ok, but jumps from For i =2 ... line to End Sub.
Sub Adjust()
Dim lastrow As Long
Dim i As Long
Dim headers As Dictionary
Dim c As Long
Set headers = New Scripting.Dictionary
For c = 1 To Cells(3, Columns.Count).End(xlToLeft).Column
headers.Add Cells(3, c).Value, c
Next c
lastrow = Cells(headers.Item("Survey: Interest to Participate") & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Not IsError(Cells(i, headers.Item("Survey: Interest to Participate")).Value) Then
If Cells(i, headers.Item("Survey: Interest to Participate")).Value = "No" And Cells(i, headers.Item("Role")).Value = "MEM" Then
Cells(i, headers.Item("Role")).Value = "C-MEM"
Cells(i, headers.Ittem(" Follow-up date")).ClearContents
Cells(i, headers.Item("REV profile follow-up date")).Value = "N/A"
ElseIf Cells(i, headers.Item("Survey: Interest to Participate")).Value = "No" And Cells(i, headers.Item("Role")).Value = "VCH" Then
Cells(i, headers.Item("Role")).Value = "C-VCH"
Cells(i, headers.Ittem(" Follow-up date")).ClearContents
Cells(i, headers.Item("REV profile follow-up date")).Value = "N/A"
End If
End If
Next i
End Sub
The way I'd go about this would be to create a Dictionary with header names as keys and column numbers as values:
Dim headers As Dictionary
Set headers = New Scripting.Dictionary
Dim c As Long
'Assuming headers are in row 1 for sake of example...
For c = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
headers.Add Cells(1, c).Value, c
Next
Then, instead of using hard-code column letters with the Range, use the Cells collection and index it by column number using the Dictionary to look it up based on the header. For example, if your code expects column "U" to be under that header "Role" here:
Range("U" & i).Value = "C-MEM"
You can replace it with a column lookup like this using the Dictionary like this:
Cells(i, headers.Item("Role")).Value = "C-MEM"
Note that this requires a reference to the Microsoft Scripting Runtime (Tools->References... then check the box).
But this is a shared workbook, so people are adding columns randomly and every time I need to go back to the code and modify the columns refereces.
Protect the workbook to prevent this undesired behavior?
I would personally prefer to use Named Ranges, which will adjust with insertions and re-sorting of the data columns.
From Formulas ribbon, define a new name:
Then, confirm that you can move, insert, etc., with a simple procedure like:
Const ROLE As String = "Role"
Sub foo()
Dim rng As Range
Set rng = Range(ROLE)
' This will display $B$1
MsgBox rng.Address, vbInformation, ROLE & " located:"
rng.Offset(0, -1).Insert Shift:=xlToRight
' This will display $C$1
MsgBox rng.Address, vbInformation, ROLE & " located:"
rng.Cut
Application.GoTo Range("A100")
ActiveSheet.Paste
' This will display $A$100
MsgBox rng.Address, vbInformation, ROLE & " located:"
End Sub
So, I would define a Named Range for each of your columns (presently assumed to be AE, U, Y & AJ). The Named Range can span the entire column, which will minimize changes to the rest of your code.
Given 4 named ranges like:
Role, representing column U:U
RevProfile, representing column AJ:AJ
FollowUp, representing column Y:Y
Intent, representing column AE:AE
(NOTE: If you anticipate that users may insert rows above your header rows, then I would change the Named range assignments to only the header cells, e.g., "$AE$1", "$U$1", etc. -- this should require no additional changes to the code below)
You could do like this:
'Constant strings representing named ranges in this worksheet
Public Const ROLE As String = "Role"
Public Const REVPROFILE As String = "RevProfile"
Public Const FOLLOWUP As String = "FollowUp"
Public Const INTENT As String = "Intent"
Sub AdjustForNoIntent()
'Adjusts columns Role(U) (to C-MEM), REV Profile Follow-up Date(AJ) (to N/A) and deletes Follow-up Date(Y) when column Survey: Intent to Participate = No
Dim lastrow As Long
Dim i As Long
lastrow = Range(INTENT).End(xlUp).Row
For i = 2 To lastrow
If Not IsError(Range(INTENT).Cells(i).Value) Then
If Range(INTENT).Cells(i).Value = "No" And Range(ROLE).Cells(i).Value = "MEM" Then
Range(ROLE).Cells(i).Value = "C-MEM"
Range(FOLLOWUP).ClearContents
Range(REVPROFILE).Cells(i).Value = "N/A"
ElseIf Range(INTENT).Cells(i).Value = "No" And Range(ROLE).Cells(i).Value = "VCH" Then
Range(ROLE).Cells(i).Value = "C-VCH"
Range(FOLLOWUP).Cells(i).ClearContents
Range(REVPROFILE).Value = "N/A"
End If
End If
Next
End Sub
I would go with David Zemens answer but you could also use Range().Find to get the correct columns.
Here I refactored you code to find and set references to your column headers. Everything is based relative to these references.
Here I set a reference to Row 3 of the Survey column where your column header is:
Set rSurvey = .Rows(3).Find(What:="Survey", MatchCase:=False, Lookat:=xlWhole)
Because everything is relative to rSurvey the last row is = the actual last row - rSurvey's row
lastrow = rSurvey(.Rows.Count - rSurvey.Row).End(xlUp).Row - rSurvey.Row
Since rSurvey is a range we know that rSurvey.Cells(1, 1) is our column header. What isn't apparent is that since rSurvey is a range rSurvey(1, 1) is also our column header and since column and row indices are optional rSurvey(1) is also the column header cell.
Know all of that we can iterate over the cells in each column like this
For i = 2 To lastrow
rSurvey( i )
Sub AdjustForNoIntent()
'Adjusts columns Role(U) (to C-MEM), REV Profile Follow-up Date(AJ) (to N/A) and deletes Follow-up Date(Y) when column Survey: Intent to Participate = No
Dim lastrow As Long
Dim i As Long
Dim rRev As Range 'AJ
Dim rRole As Range 'U
Dim rFollowUp As Range 'Y
Dim rSurvey As Range 'AE
With Worksheets("Tracking")
Set rRev = .Rows(3).Find(What:="REV", MatchCase:=False, Lookat:=xlWhole)
Set rRole = .Rows(3).Find(What:="Role", MatchCase:=False, Lookat:=xlWhole)
Set rFollowUp = .Rows(3).Find(What:="Follow-up", MatchCase:=False, Lookat:=xlWhole)
Set rSurvey = .Rows(3).Find(What:="Survey", MatchCase:=False, Lookat:=xlWhole)
lastrow = rSurvey(.Rows.Count - rSurvey.Row).End(xlUp).Row - rSurvey.Row
End With
For i = 2 To lastrow
If Not IsError(rSurvey(i).value) Then
If rSurvey(i).value = "No" And rRole(i).value = "MEM" Then
rRole(i).value = "C-MEM"
rFollowUp(i).ClearContents
rRev(i).value = "N/A"
ElseIf rSurvey(i).value = "No" And rRole(i).value = "VCH" Then
rRole(i).value = "C-VCH"
rFollowUp(i).ClearContents
rRev(i).value = "N/A"
End If
End If
Next i
End Sub
I don't understand syntax for range.
Why does this work:
For i = 1 To 10
Range("A" & i & ":D" & i).Copy
Next
But this doesn't work:
For i = 2 To lastRow
num = WorksheetFunction.Match(Cells(i, 1), Range("A" & lastRow), 0)
Next
Why do I need to use
For i = 2 To lastRow
'num = WorksheetFunction.Match(Cells(i, 1), Range("A1:A" & lastRow), 0)
Next
What A1:A mean? Why can't I use
Range("A" & lastRow), 0
There is nothing wrong with your syntax and your code should've work just fine.
The problem with using worksheet function like Match, Vlookup and other look up functions is that if the value being searched is not found, it throws up an error.
In your case, you are trying to search multiple values in just one cell.
So let us say your lastrow is 9. You're code will loop from Cell(2,1) to Cell(9,1) checking if it is within Range("A" & lastrow) or Range("A9").
If your values from Cell(2,1) through Cell(9,1) is the same as your value in Range("A9"), you won't get an error.
Now, if you use Range("A1:A" & lastrow), it will surely work cause you are trying to match every element of that said range to itself and surely a match will be found.
WorksheetFunction.Match(Cells(2,1), Range("A1:A9")) 'will return 2
WorksheetFunction.Match(Cells(3,1), Range("A1:A9")) 'will return 3
'
'
'And so on if all elements are unique
It doesn't matter if you use Range("A9") or Range("A1:A9").
What matters is that you handle the error in case you did not find a match.
One way is to use On Error Resume Next and On Error Goto 0 like this:
Sub ject()
Dim num As Variant
Dim i As Long, lastrow As Long: lastrow = 9
For i = 2 To lastrow
On Error Resume Next
num = WorksheetFunction.Match(Cells(i, 1), Range("A" & lastrow), 0)
If Err.Number <> 0 Then num = "Not Found"
On Error GoTo 0
Debug.Print num
Next
End Sub
Another way is to use Application.Match over WorksheetFunction.Match like this:
Sub ject()
Dim num As Variant
Dim i As Long, lastrow As Long: lastrow = 9
For i = 2 To lastrow
num = Application.Match(Cells(i, 1), Range("A" & lastrow), 0)
Debug.Print num
'If Not IsError(num) Then Debug.Print num Else Debug.Print "Not Found"
Next
End Sub
Application.Match works the same way but it doesn't error out when it returns #N/A. So you can assign it's value in a Variant variable and use it later in the code without any problem. Better yet, use IsError test to check if a value is not found as seen above in the commented lines.
In both cases above, I used a Variant type num variable.
Main reason is for it to handle any other value if in case no match is found.
As for the Range Syntax, don't be confused, it is fairly simple.
Refer to below examples.
Single Cell - All refer to A1
Cells(1,1) ' Using Cell property where you indicate row and column
Cells(1) ' Using cell property but using just the cell index
Range("A1") ' Omits the optional [Cell2] argument
Don't be confused with using cell index. It is like you are numbering all cells from left to right, top to bottom.
Cells(16385) ' refer to A2
Range of contiguous cell - All refer to A1:A10
Range("A1:A10") ' Classic
Range("A1", "A10") ' or below
Range(Cells(1, 1), Cells(10, 1))
Above uses the same syntax Range(Cell1,[Cell2]) wherein the first one, omits the optional argument [Cell2]. And because of that, below also works:
Range("A1:A5","A6:A10")
Range("A1", "A8:A10")
Range("A1:A2", "A10")
Non-Contiguous cells - All refer to A1, A3, A5, A7, A9
Range("A1,A3,A5,A7,A9") ' Classic
Without any specific details about the error, I assume that Match does not return the value you expect, but rather an #N/A error. Match has the syntax
=match(lookup_value, lookup_range, match_type)
The lookup_range typically consists of a range of several cells, either a column with several rows or a row with several columns.
In your formula, you have only one cell in the lookup_range. Let's say Lastrow is 10. The first three runs of the loop produce the formula
=Match(A2,A10,0)
=Match(A3,A10,0)
=Match(A4,A10,0)
It is a valid formula but in most cases the result won't be a match but an error. Whereas what you probably want is
=Match(A2,A1:A10,0)
Looking again at your code, stitch it together and find why you need A1:A as a string constant in your formula:
For i = 2 To lastRow
num = WorksheetFunction.Match(Cells(i, 1), Range("A1:A" & lastRow), 0)
Next
I'm working on a macro that is supposed to count the number of times the term "GM" appears in a column. I decided to use a countif statement, as I have before and it worked well. However, for some reason when I run my code it outputs 0 every time, which definitely is not correct. I've run this same code with other columns and strings and it has worked fine, but for some reason if I search this certain column for the term "GM" it fails. The only thing I can think of is maybe countif only works if the string you're searching for is the only string in a cell, because in all cases where this is true the code works fine. In this particular case the string I'm looking for is not the only string in the cell and the code is failing. I've tried to find more info on whether or not this is true but I can't find anything online. Here's the code if anyone would like to take a look:
Function OemRequest() As Long
Sheets("CS-CRM Raw Data").Select
Sheets("CS-CRM Raw Data").Unprotect
Dim oem As Long
Dim LastRow As Long
Dim LastColumn As Long
'Determines size of table in document
LastRow = Range("A" & Rows.Count).End(xlUp).row
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
oem = Application.WorksheetFunction.CountIf(Range(2 & "2:" & 2 & LastRow), "gm")
OemRequest = oem
End Function
You are correct that the COUNTIF as written will only match cells where the whole content is "gm". The criteria in the COUNTIF function will also accept wildcards, so to match on cells that contain "gm" do:
.CountIf(Range(2 & "2:" & 2 & LastRow), "*gm*")
Update
As you noted there is also an issue with your Range call. As it is, the expression inside the parens will evaluate to "22:2<LastRow>" (where <LastRow> is the value of the LastRow variable).
The 2's in there should be a variable containing the column name you're interested in. Something like:
Dim col as String
col = "B"
... Range(col & "2:" & col & LastRow) ...
This will evaluate to "B2:B<LastRow>", which is what you want.
Another possibility:
oem = WorksheetFunction.CountIf(Columns(LastColumn).Cells(2).Resize(rowsize:=LastRow - 1), "gm")
This will count cells containing "gm" (use wilcards if needed) in the LAST column of the table, except the one in the first row. (It assumes the table upper left corner is in cell "A1")
Of course you can create a variable if you would like to count any other column:
Dim lngCol as Long
lngCol = ...
oem = WorksheetFunction.CountIf(Columns(lngCol).Cells(2).Resize(rowsize:=LastRow - 1), "gm")
I think in this way
Sub Main()
Application.ScreenUpdating = 0
Dim Count As Double
Range("C1").Activate 'Firs row in the column
Do While ActiveCell.Value <> ""
If InStr(ActiveCell.Value, "MyText") Then
Count = Count + 1
End If
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = 1
End Sub
This will work, only if the data cell is not empty, if there is an empty space in middle of the worksheet, do this:
Sub Main()
Application.ScreenUpdating = 0
Dim Count As Double
Range("C1").Activate
Do While ActiveCell.Row <> Rows.Count ' This wil evaluate all the rows in the 'C' Column
If InStr(ActiveCell.Value, "MyText") Then
Count = Count + 1
End If
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = 1
End Sub
Hope it's work for you.