I am trying to create a small piece of code which will move a row to sheet2 if: G<>M "OR" I<>0 OR L<>R
For example in my made up table below:
G I L M O R
1 2 3 1 2 4
So this particular row would be moved to sheet two as one of the statements was satisfied: L<>R
I have this code so far:
Sub SingleTradeMove()
lastRow = Sheets("Trade data").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Range("A2:AK600").ClearContents
For i = 2 To lastRow
If Sheets("Trade data").Cells(i, "J").Value = "" Then
Sheets("Trade data").Cells(i, "J").EntireRow.Copy Destination:=Sheets
("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End Sub
Assume GILMOR starts in column A. Change column references as needed.
Sub SingleTradeMove()
Dim wsTD as Worksheet
Set wsTD = Worksheets("Trade data")
Sheets("Sheet2").Range("A2:AK600").ClearContents
With wsTD
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If .Cells(i, "J").Value = "" Or .Cells(i,"A") <> .Cells(i,"D") _
Or .Cells(i,"B") <> .Cells(i,"E") _
Or .Cells(i,"C") <> .Cells(i,"F") Then
.Cells(i, "J").EntireRow.Copy _
Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End With
End Sub
Related
In my code there is a searching order and it does as folloing:
It takes each value (about 2000 ranges) in ws.sheet range A and looks it up in another sheet named wp.sheet range A (about 90 ranges). If a particular value x in ws.sheet range e.g A3 is not found in wp.sheet range A the next search order in sheet ws.sheet is the value y in the next range B3 (same row as value x) to be searched in sheet wp.sheet in the entire range B, and so on.
This is what my "for" loop does and the issue with my code is that it takes very long as it compares each value in ws.sheet range A1-2000 to the values in wp.sheet range A1-90. Is there an alternative which does it more quickly or more efficiently?
Dim wb As Workbook, wq As Object
Dim ws, wi As Worksheet, datDatum
Dim w As Long, I As Long, t As Long
Dim DefaultMsgBox()
Dim r, i As Integer
For r = 2 To 2000
Check = True:
For i = 1 To 90
If ws.Range("A" & r).Value = wp.Sheets("ABC").Range("A" & i).Value Then
wp.Sheets("ABC").Rows(i).Columns("E:AB").Copy
ws.Range("G" & r).PasteSpecial
GoTo NextR
End If
Next i
For i = 1 To 90
If ws.Range("B" & r).Value = wp.Sheets("ABC").Range("B" & i).Value Then
wp.Sheets("ABC").Rows(i).Columns("E:AB").Copy
ws.Range("G" & r).PasteSpecial
GoTo NextR
End If
Next i
For i = 1 To 90
If ws.Range("C" & r).Value = wp.Sheets("ABC").Range("C" & i).Value And ws.Range("D" & r).Value = wp.Sheets("ABC").Range("D" & i).Value Then
wp.Sheets("ABC").Rows(i).Columns("E:AB").Copy
ws.Range("G" & r).PasteSpecial
GoTo NextR
End If
Next i
NextR:
If Not Check = ws.Range("A" & r).Value = wp.Sheets("ABC").Range("A" & i).Value Or Not Check = ws.Range("B" & r).Value = wp.Sheets("ABC").Range("A" & i).Value Or Not Check = ws.Range("C" & r).Value = wp.Sheets("ABC").Range("C" & i).Value And ws.Range("D" & r).Value = wp.Sheets("ABC").Range("D" & i).Value Then
MsgBox "......"
End If
Next r
End sub
I would suggest turning off ScreenUpdating and using the Find function instead:
Dim cell, foundValue, lookupRange As Range
Set wp = ThisWorkbook.Sheets("ABC")
Set ws = ThisWorkbook.Sheets("WS")
r = 2
number_r = 2000
ru = 1
number_ru = 90
Application.ScreenUpdating = False
'Loop through each cell in WS, offsetting through columns A to C
For Each cell In ws.Range("A" & r & ":A" & number_r)
For i = 0 To 2
'Define range to look up in ABC
Set lookupRange = wp.Range(wp.Cells(ru, i + 1), wp.Cells(number_ru, i + 1))
'Look for current WS cell on corresponding column in ABC
Set foundValue = lookupRange.Find(cell.Offset(0, i).Value)
'If cell is found in ABC...
If Not foundValue Is Nothing Then
Select Case i
Case 2 'If found cell is in column C
Do 'Lookup loop start
'If same values on columns D...
If foundValue.Offset(0, 1).Value = cell.Offset(0, 3).Value Then
'Copy data to WS and switch to the next cell
wp.Rows(foundValue.Row).Columns("E:AB").Copy
ws.Range("G" & cell.Row).PasteSpecial
GoTo nextCell
'If not same values on columns D...
Else
'Try to find next match, if any
Set foundValue = lookupRange.FindNext(foundValue)
If foundValue Is Nothing Then GoTo noMatchFound
End If
Loop 'Repeat until WS values in column C and D match ABC values in columns C and D
Case Else 'If found cell is in column A or B
'Copy data to WS and switch to the next cell
wp.Rows(foundValue.Row).Columns("E:AB").Copy
ws.Range("G" & cell.Row).PasteSpecial
GoTo nextCell
End Select
End If
Next i
noMatchFound:
MsgBox "......" 'Message appears only when no match was found in column A, column B and column C + D
nextCell:
Next cell
Application.ScreenUpdating = True
I hope you don't mind my saying so, but your code is hard to follow, including your choice of variable names. I can recommend that if you do not make use of your .copy statements, then comment them out and your code will run much faster.
I have to create a report where I get a raw data with a list of transactions, I need my macro to send each transaction to its respective sheets based on if Portfolio name at C Column
I manged to do that, but now I need Transaction of Nokia that fall under 'Cash' from the below given reference sheet, to paste under sheet "Nokia - Cash"
Can someone please help me build the 2nd part of my code which helps to move the if C=Nokia and J = Semi Paid then move to Nokia - Cash?
It is similar to the previous question I have answered.
You don't have to worry about creating the sheets and naming them, the code handles it. It also skips the items which are not found in reference sheet.
It matches the description item with item in your reference sheet, then concats card name with the matched item's category name in order to name the relevant sheet. If this sheet does not exist, it creates and pass the row data, otherwise simply pass the row data.
Sub MyClients()
Dim lastrow As Long, lastcol As Long, matchrow As Long, i As Long, j As Long
Dim wsname As String
lastrow = Worksheets("Raw").Cells(Worksheets("Raw").Rows.Count, 1).End(xlUp).Row
lastcol = Worksheets("Raw").Cells(1, Worksheets("Raw").Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
For i = 2 To lastrow
On Error Resume Next
matchrow = Application.WorksheetFunction.Match(Worksheets("Raw").Cells(i, 10).Value, Worksheets("Reference").Range("A:A"), 0)
If Err.Number = 1004 Then
MsgBox "Couldn't find item: '" & Worksheets("Raw").Cells(i, 10).Value & "' within reference sheet. Skipping row no: " & i
GoTo skip:
End If
wsname = Worksheets("Raw").Cells(i, 3).Value & " - " & Worksheets("Reference").Cells(matchrow, 2).Value
On Error Resume Next
Worksheets(wsname).Cells(Worksheets(wsname).Rows.Count, 1).End(xlUp).Offset(1, 0) = Worksheets("Raw").Cells(i, 1).Value
For j = 1 To lastcol - 1
Worksheets(wsname).Cells(Worksheets(wsname).Rows.Count, 1).End(xlUp).Offset(0, j) = Worksheets("Raw").Cells(i, j).Value
Next j
If Err.Number = 9 Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = wsname
For j = 1 To lastcol
Worksheets(wsname).Cells(1, j) = Worksheets("Raw").Cells(1, j).Value
Next j
Worksheets(wsname).Cells(Worksheets(wsname).Rows.Count, 1).End(xlUp).Offset(1, 0) = Worksheets("Raw").Cells(i, 1).Value
For j = 1 To lastcol - 1
Worksheets(wsname).Cells(Worksheets(wsname).Rows.Count, 1).End(xlUp).Offset(0, j) = Worksheets("Raw").Cells(i, j).Value
Next j
End If
skip:
Next i
Worksheets("Raw").Activate
Application.ScreenUpdating = True
End Sub
here is my case :
Column A is empty.
Column B is the room number of a guest
Column C is the Name of the guest in that room
I am trying to count how many room are occupied. so I put a count formula but the Result is 0. I don't know why..
Here is the code:
Sheets("Champagne").Select
Range("B2").AutoFill Destination:=Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
LastRow = Range("A2").End(xlDown).Row
Cells(LastRow + 2, "A").Formula = "=SUM(A2:A" & LastRow & ")"
LRowA = [A4200].End(xlUp).Address
Range("A:A").Interior.ColorIndex = xlNone
Range("A2:" & LRowA).Interior.ColorIndex = 33
Range("A:A").HorizontalAlignment = xlCenter
so then I was trying to put a formula to say if Column B as any Number (the room number), it will count as 1 in the column A. And then put a Sum at the end of Column A.
Here is the code that I am trying to put but it puts 123456 in the column C.
Sheets("Champagne").Select
For Each Cel In Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
If Cel.Value <> "" Then Cel.Offset(1, 0).Value = "123456"
Range("A2").AutoFill Destination:=Range("A2:A" & Cells(Rows.Count, 2).End(xlUp).Row)
LastRow = Range("A2").End(xlDown).Row
Next
Range("B2").AutoFill Destination:=Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row)
LastRow = Range("A2").End(xlDown).Row
Cells(LastRow + 2, "A").Formula = "=SUM(A2:A" & LastRow & ")"
LRowA = [A4200].End(xlUp).Address
Range("A:A").Interior.ColorIndex = xlNone
Range("A2:" & LRowA).Interior.ColorIndex = 33
Range("A:A").HorizontalAlignment = xlCenter
If you have an answer with the first code, I take it as well....
To count how many rooms (column B) are occupied I would use code like:
Function CountOccupiedRooms(sheetname As String) As Long
Dim j As Long
dim c As Range
With Worksheets(sheetname)
'Check that some data exists
If IsEmpty(.Range("B2").Value) Then
CountOccupiedRooms = 0
Exit Function
End If
For Each c In .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
If Application.WorksheetFunction.CountIf(.Range("B2:B" & c.Row), c.Value) = 1 Then
j = j + 1
End If
Next
End With
CountOccupiedRooms = j
End Function
and then, assuming you wanted to put that number in a cell somewhere, that code could be called in your main code as
Worksheets("Summary").Range("C5").Value = CountOccupiedRooms("Champagne")
Worksheets("Summary").Range("C6").Value = CountOccupiedRooms("ChocoStrawb")
The destination worksheet name ("Summary") and the locations ("C5" and "C6") were just made up for illustration purposes - you can use whatever you like.
Scenario
I have three workbooks
Master
Planner
Phonebook
In my master workbook, i have a value in cell I8 on sheet 1.
Master (Sheet 1)
I8 = 2
On sheet 2 i have the following empty columns:
Master (Sheet 2)
Column A (number) Column B (Supplier) Column C (Contact)
I intend to populate these columns with data from both planner workbook and phonebook workbook.
In my planner, I have a list of numbers in column A and suppliers in Column N.
Numbers Supplier
2 A
2 B
2 C
3 D
4 E
2 F
I am trying to copy all the suppliers from my planner workbook that match the value in cell I8 (in this instance it is 2).
I am pasting the numbers (2) in column A and pasting the supplier names into column B in master workbook.
My code already copies and pastes these values fine.
(I am also copying other values from planner into other columns in master - but for this question, these are not relevant).
So this part of my code works fine.
The problem
Once the suppliers have been pasted into column B in master workbook - I also want to copy the contact name for each supplier from my workbook phonebook.
My phonebook workbook has sheets A-Z and suppliers are listed under these sheets alphabetically.
Phonebook:
Supplier (Column A) Contact Name (Column C)
A Linda
Aa Dave
Aa Terry
AB James
A | B | C | D etc... <----- Sheets
I need to look in each sheet in column A of the phonebook for a supplier name that matches the supplier name in column B (master).
If the supplier name matches then I want to copy the contact name in column C over to master workbook column C.
My result should look like this
Master (Sheet 2)
Column A (number) Column B (Supplier) Column C (Contact)
2 A Linda
2 A Linda
Here's my code:
Option Explicit
Sub CreateAnnounce()
Dim WB As Workbook
Dim WB2 As Workbook
Dim i As Long
Dim i2 As Long
Dim j As Long
Dim LastRow As Long
Dim j2 As Long
Dim LastRow2 As Long
Dim ws As Worksheet
'Open Planner
On Error Resume Next
Set WB = Workbooks("2017 Planner.xlsx")
On Error GoTo 0
If WB Is Nothing Then 'open workbook if not open
Set WB = Workbooks.Open("G:\BUYING\Food Specials\2. Planning\1. Planning\1. Planner\8. 2017\2017 Planner.xlsx")
End If
'Open PhoneBook
On Error Resume Next
Set WB2 = Workbooks("Phone Book for Food Specials.xls")
On Error GoTo 0
If WB2 Is Nothing Then 'open workbook if not open
Set WB2 = Workbooks.Open("G:\BUYING\Food Specials\1. General\Phone Book\Phone Book for Food Specials.xls")
End If
' ======= Edit #2 , also for DEBUG ======
With WB.Worksheets(1)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
j = 2
For i = 1 To LastRow
' === For DEBUG ONLY ===
Debug.Print CInt(ThisWorkbook.Worksheets(1).Range("I8").Value)
If CInt(ThisWorkbook.Worksheets(1).Range("I8").Value) = .Range("A" & i).Value Then ' check if Week No equals the value in "A1"
ThisWorkbook.Worksheets(2).Range("A" & j).Value = .Range("A" & i).Value
ThisWorkbook.Worksheets(2).Range("B" & j).Value = .Range("N" & i).Value
ThisWorkbook.Worksheets(2).Range("H" & j).Value = .Range("K" & i).Value
ThisWorkbook.Worksheets(2).Range("I" & j).Value = .Range("L" & i).Value
ThisWorkbook.Worksheets(2).Range("J" & j).Value = .Range("M" & i).Value
ThisWorkbook.Worksheets(2).Range("K" & j).Value = .Range("G" & i).Value
ThisWorkbook.Worksheets(2).Range("L" & j).Value = .Range("O" & i).Value
ThisWorkbook.Worksheets(2).Range("M" & j).Value = .Range("P" & i).Value
ThisWorkbook.Worksheets(2).Range("N" & j).Value = .Range("W" & i).Value
ThisWorkbook.Worksheets(2).Range("O" & j).Value = .Range("Z" & i).Value
'Retrieve Contact Details for supplier
'Worksheet 1
'Retrieve Contact Details for supplier
With WB2.Worksheets(2)
LastRow2 = .Cells(.Rows.Count, "A").End(xlUp).Row
j2 = 2
For i2 = 1 To LastRow2
Dim rngToFill As Range
Set rngToFill = .Range("C2")
Do
Debug.Print ThisWorkbook.Worksheets(2).Range("B" & j2).Value
If ThisWorkbook.Worksheets(2).Range("B" & j2).Value Like .Range("A" & i2).Value Then ' check if Company equals the value in "B1 Phonebook"
ThisWorkbook.Worksheets(2).Range("C2").Value = .Range("C" & i2).Value
Set rngToFill = rngToFill.Offset(1, 0)
End If
Loop
Next i2
End With
'Retrieve Contact Details for supplier - END
End If
Next i
End With
End Sub
For some reason, the code is Copying/pasting just 1 single contact name on the first row into master workbook.
I am also aware that at the moment I am only looking across one sheet.
With WB2.Worksheets(2)
I need this code to obviously look across all sheets for all supplier contact names.
Please can someone show me where I am going wrong and how to get this code to work? Thanks in advance.
EDIT:
I have composed the code suggested by user #BjornBogers
'Retrieve Contact Details for supplier
Dim FoundCellRng As Range
Dim ContactValue As String
Dim SearchStr As String
For i2 = 1 To 26
'Assuming --> ThisWorkbook.Worksheets(2).Range("B1").Value is what you are looking for?
SearchStr = ThisWorkbook.Worksheets(2).Range("B2").Value
Set FoundCellRng = WB2.Worksheets(i2).Range("A2:A200").Find(SearchStr)
If (FoundCellRng Is Nothing) Then
'Didn't find anything
Else
'We found it
ContactValue = WB2.Worksheets(i2).Cells(FoundCellRng.Row, FoundCellRng.Column + 2).Value
ThisWorkbook.Worksheets(2).Range("C" & j).Value = ContactValue
Exit For
End If
Next i2
'Retrieve Contact Details for supplier - END
However, this does the same thing, only one contact name is being entered in the top row but nothing more.
EDIT 2:
With the code #R3uK provided, i seem to be getting the following issues:
Supplier names and other values are not copying across correctly.
The same value seems to repeat itself again and again in column I.
For some reason, this code creates another sheet? What is this sheet for?
The code is incredibly slow and i am having to wait 20 minutes or more.
Is there a way to speed this up?
I haven't tested this but you could try the following:
Dim FoundCellRng As Range
Dim ContactValue As String
Dim SearchStr As String
For i = 1 To 26
'Assuming --> ThisWorkbook.Worksheets(2).Range("B1").Value is what you are looking for?
SearchStr = ThisWorkbook.Worksheets(2).Range("B1").Value
Set FoundCellRng = WB2.Worksheets(i).Range("A1:A100").Find(SearchStr)
If (FoundCellRng Is Nothing) Then
'Didn't find anything
Else
'We found it
ContactValue = WB.Worksheets(i).Cells(FoundCellRng.Row, FoundCellRng.Column + 2).Value
Exit For
End If
Next i
Sub CreateAnnounce()
Dim WbMaster As Workbook
Dim wSMaster1 As Worksheet
Dim wSMaster2 As Worksheet
Dim wSMastTemp As Worksheet
Dim WbPlan As Workbook
Dim wSPlan1 As Worksheet
Dim WbPhone As Workbook
Dim wSPhone As Worksheet
Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim rngToFill As Range
Dim rngToChk As Range
Set WbMaster = ThisWorkbook
Set wSMaster1 = WbMaster.Sheets(1)
Set wSMaster2 = WbMaster.Sheets(2)
Set wSMastTemp = WbMaster.Sheets.Add
'''Open Planner
Set WbPlan = GetWB("2017 Planner.xlsx", "G:\BUYING\Food Specials\2. Planning\1. Planning\1. Planner\8. 2017\2017 Planner.xlsx")
Set wSPlan1 = WbPlan.Sheets(1)
'''Open PhoneBook
Set WbPhone = GetWB("Phone Book for Food Specials.xls", "G:\BUYING\Food Specials\1. General\Phone Book\Phone Book for Food Specials.xls")
With wSPlan1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
j = 2
For i = 1 To LastRow
'''Check if Week No equals the value in "A1"
If CInt(wSMaster1.Range("I8").Value) = .Range("A" & i).Value Then
wSMaster2.Range("A" & j).Value = .Range("A" & i).Value
wSMaster2.Range("B" & j).Value = .Range("N" & i).Value
wSMaster2.Range("H" & j & ":J" & j).Value = .Range("K" & i & ":M" & i).Value
wSMaster2.Range("K" & j).Value = .Range("G" & i).Value
wSMaster2.Range("L" & j & ":M" & j).Value = .Range("O" & i & ":P" & i).Value
wSMaster2.Range("N" & j).Value = .Range("W" & i).Value
wSMaster2.Range("O" & j).Value = .Range("Z" & i).Value
'''Store those infos for next results
wSMastTemp.Cells.Clear
wSMastTemp.Range("A1:O1").Value = wSMaster2.Range("A" & j & ":O" & j).Value
'''Retrieve Contact Details for supplier
Set rngToFill = wSMaster2.Range("C" & j)
For Each wSPhone In WbPhone.Sheets
With wSPhone
'''Define properly the Find method to find all
Set rngToChk = .Columns(1).Find(What:=wSMaster2.Range("B" & j).Value, _
After:=.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
'''If there is a result, keep looking with FindNext method
If Not rngToChk Is Nothing Then
FirstAddress = rngToChk.Address
Do
'''Transfer the cell value to the master
rngToFill.Value = rngToChk.Offset(, 2).Value
'''Go to next row on the template for next Transfer
Set rngToFill = rngToFill.Offset(1, 0)
'''Copy the Info from 1st row for the next result
wSMaster2.Range("A" & rngToFill.Row & ":O" & rngToFill.Row).Value = wSMastTemp.Range("A1:O1").Value
'''Look until you find again the first result in that sheet
Set rngToChk = .Columns(1).FindNext(rngToChk)
Loop While Not rngToChk Is Nothing And rngToChk.Address <> FirstAddress
Else
End If
End With 'wSPhone
Next wSPhone
'''Restart to fill from the next available row
j = rngToFill.Row
'''Clean Data that was there for the next result of this test
wSMaster2.Range("A" & j & ":O" & j).ClearContents
End If
Next i
End With
Application.DisplayAlerts = False
wSMastTemp.Delete
Application.DisplayAlerts = True
End Sub
Public Function GetWB(FileName As String, FileFullPath As String) As Workbook
On Error Resume Next
Set GetWB = Workbooks(FileName)
On Error GoTo 0
If GetWB Is Nothing Then 'open workbook if not open
Set GetWB = Workbooks.Open(FilePath)
DoEvents
End If
End Function
I have an excel sheet of which the data was jumbled: for example, the data that should have been in Columns AB and AC were instead in Columns B and C, but on the row after. I have the following written which moved the data from B and C to AB and AC respectively:
Dim rCell As Range
Dim rRng As Range
Set rRng = Sheet1.Range("A:A")
i = 1
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For Each rCell In rRng.Cells
If rCell.Value = "" Then
Range("AB" & i) = rCell.Offset(0, 1).Value
rCell.Offset(0, 1).ClearContents
End If
i = i + 1
If i = lastRow + 1 Then
Exit Sub
End If
Next rCell
End Sub
However, it doesn't fix the problem of the data being on the row BELOW the appropriate row now that they are in the right columns. I am new to VBA Macros so I would appreciate any help to make the data now align. I tried toggling the Offset parameter (-1,0) but it's not working.
Try something like this?
For i = Lastrow To 1 Step -1
' move data into cell AA from Cell A one row down
Cells(i, 27).Value = Cells(i + 1, 1).Value
Next
You don't need to loop through the range to accomplish what you're trying to do.
Try this instead:
Sub MoveBCtoAbAcUpOneRow()
Dim firstBRow As Integer
Dim lastBRow As Long
Dim firstCRow As Integer
Dim lastCRow As Long
' get the first row in both columns
If Range("B2").Value <> "" Then
firstBRow = 2
Else
firstBRow = Range("B1").End(xlDown).Row
End If
If Range("C2").Value <> "" Then
firstCRow = 2
Else
firstCRow = Range("C1").End(xlDown).Row
End If
' get the last row in both columns
lastBRow = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row
lastCRow = Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row
' copy the data to the correct column, up one row
Range("B" & firstBRow & ":B" & lastBRow).Copy Range("AB" & firstBRow - 1)
Range("C" & firstCRow & ":C" & lastCRow).Copy Range("AC" & firstCRow - 1)
' clear the incorrect data
Range("B" & firstBRow & ":B" & lastBRow).ClearContents
Range("C" & firstCRow & ":C" & lastCRow).ClearContents
End Sub
Notes:
If the shape of data in each column is the same, you don't need to
find the first and last row for each. You'll only need one variable for each and one copy operation instead of 2.
Make sure you set variable declaration to required.
(Tools -> Options -> Require Variable Declaration) You may already be doing this, but I couldn't tell because it looks like the top of your Sub got truncated.