Essentially I tried doing using using Macro and see how it records in VBA. I have this dataset where I want to copy company names from a sheet and paste it next to years ranging from 1994-2014. And then repeat the same process for more roughly 800 companies.
I tried doing one with this code but I believe I need to loop the code. Not really a VBA expert just trying to saving time and error using VBA
Sub CopyPaste()
CopyPaste Macro
Sheets("Name").SelectRange("C3").Select
Selection.Copy
Sheets("Stata").Select
Range("B2:B22").PasteSpecial xlPasteValues
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub
This is going to be very crude but the following code will accomplish what you want. Especially if you only need to do this exercise once.
In my example the companies list starts in cell A2 and the output starts in cell D2. I have used 3 years (2019 - 2021)
For the code below, the location (row & col) of the first company are placed in the variables copyRow & copyCol as integers (ie A2 = Row: 2, Col: 1) The first cell of the output location is set in the pasteRow & pasteCol (ie D2 = Row: 2, Col: 4) variables. Also the start year and end year are also set in the startYear and endYear variables.
Basically, from there it is just two nested loops. A while for the companies that allows any number of companies as long as there are no empty cells in the list. The for loop to cycle through each year between startYear and endYear for each company.
Sub copyPaste()
Dim copyWb As Workbook
Dim copySht As Worksheet
Dim pasteRow As Integer
Dim pasteCol As Integer
Dim copyRow As Integer
Dim copyCol As Integer
Dim startYear As Integer
Dim endYear As Integer
Set copyWb = ActiveWorkbook
Set copySht = copyWb.ActiveSheet
copySht.Activate
pasteRow = 2
pasteCol = 4
copyRow = 2
copyCol = 1
startYear = 2019
endYear = 2021
While copySht.Cells(copyRow, copyCol).Value <> ""
For curYear = startYear To endYear
copySht.Cells(pasteRow, pasteCol).Value = curYear
copySht.Cells(pasteRow, pasteCol + 1).Value = copySht.Cells(copyRow, copyCol).Value
pasteRow = pasteRow + 1
Next curYear
copyRow = copyRow + 1
Wend
End Sub
I am trying to make some changes to the code as I want to copy from one and paste in another sheet. I added the variable pasteSht, but when referencing to the pasteSht.pasteRow it's throwing me an error.
Sub copyPaste()
Dim copyWb As Workbook
Dim copySht As Worksheet
Dim pasteSht As Worksheet
Dim pasteRow As Integer
Dim pasteCol As Integer
Dim copyRow As Integer
Dim copyCol As Integer
Dim startYear As Integer
Dim endYear As Integer
Set copyWb = ActiveWorkbook
Set copySht = copyWb.Worksheets("Sheet1")
Set pasteSht = copyWb.Worksheets("Sheet2")
copySht.Activate
pasteRow = 2
pasteCol = 4
copyRow = 2
copyCol = 1
startYear = 2019
endYear = 2021
While copySht.Cells(copyRow, copyCol).Value <> ""
For curYear = startYear To endYear
copySht.Cells(pasteRow, pasteCol).Value = curYear
copySht.Cells(pasteRow, pasteCol + 1).Value = copySht.Cells(copyRow, copyCol).Value
pasteRow = pasteRow + 1
Next curYear
copyRow = copyRow + 1
Wend
End Sub
Related
Is there a way to make my VBA code work for my macro? I want my macro's if function to read the first column of each worksheet in my excel (it has as many sheets as days in the exact month i'm working on), read through each cell and if the currently read cell is equal to or larger than '15 minutes compared to the first cell, then the code would execute, otherwise go to the next cell in the first column.
This is the format of the worksheets i'm working on:
TimeStamp
Power Consumption
Power Production
Inductive Power Consumption
2021.01.01. 8:12:38 +00:00
747
575
3333
2021.01.01. 8:17:35 +00:00
7674
576
3333
... etc ,
And my code looks something like this:
Sub stackoverflow()
Dim w As Integer 'index of worksheets
Dim i As Integer 'row index that steps through the first column
Dim t As Integer 'reference row index i inspect the time to
Dim x As Integer 'row index where i want my data to be printed
Dim j As Integer 'col index
Dim Timediff As Date 'not sure if this is even needed
t = 2
j = 1
x = 1
'Timediff = ("00:15:00")
For w = 3 To ActiveWorkbook.Worksheets.Count 'for every sheet from the 3rd to the last
lRow = ActiveWorkbook.Worksheets(w).Cells(Rows.Count, 1).End(xlUp).Row 'find the last row in each worksheet
lCol = ActiveWorkbook.Worksheets(w).Cells(1, Columns.Count).End(xlToLeft).Column 'find the last column in each worksheet
For x = 2 To lRow
For i = 2 To lRow
'If the time in cell(i,j) is >= then cell(t,j) + 15 minutes,
If Cells(i, j) >= DateAdd("n", 15, Cells(t, j)) Then
ActiveWorkbook.Worksheets(w).Range(i, j).Copy ActiveWorkbook.Worksheets(2).Range(x, j)
ActiveWorkbook.Worksheets(w).Range(i, j + 1).Copy ActiveWorkbook.Worksheets(2).Range(x, j + 1)
'put the new reference point after the found 15 minute mark
t = i + 1
Else
End If
Next i
Next x
Next w
End Sub
So all in all I want my code to notice when the first column reaches a 15 minute mark, and execute some code (subtracting the values of the 15 minute mark from the reference where it started, put the value in the'2nd sheet, and then step to the next cell, and repeat the process).
I'm not entirely sure which information you are attempting to copy to the second worksheet but the following code should be able to get you there pretty easily. Additionally, I've added a function that will fix the format of your TimeStamp field so that excel will recognize it and we can then do math with it
Sub TestA()
Dim xlCellA As Range
Dim xlCellB As Range
Dim xlCellC As Range
Dim i As Integer
Dim j As Integer
Dim lRow As Long
Dim lCol As Long
Set xlCellA = ActiveWorkbook.Worksheets(2).Cells(2, 1)
For i = 3 To ActiveWorkbook.Worksheets.Count
lRow = ActiveWorkbook.Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell).Row
lCol = ActiveWorkbook.Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell).Column
Set xlCellB = ActiveWorkbook.Worksheets(i).Cells(2, 1)
xlCellB.Value = FixFormat(xlCellB.Value)
xlCellB.Offset(0, lCol + 1).Value = "=DATEVALUE(MID(" & xlCellB.Address & ",1,10))+TIMEVALUE(MID(" & xlCellB.Address & ",12,8))"
For j = 3 To lRow
Set xlCellC = ActiveWorkbook.Worksheets(i).Cells(j, 1)
xlCellC.Value = FixFormat(xlCellC.Value)
xlCellC.Offset(0, lCol + 1).Value = "=DATEVALUE(MID(" & xlCellC.Address & ",1,10))+TIMEVALUE(MID(" & xlCellC.Address & ",12,8))"
If xlCellC.Offset(0, lCol + 1) - xlCellB.Offset(0, lCol + 1) >= ((1 / 24) / 4) Then
With xlCellA
.Value = xlCellC.Value
.Offset(0, 1).Value = xlCellC.Offset(0, 1).Value
End With
Set xlCellA = xlCellA.Offset(1, 0)
End If
Next j
Next i
Set xlCellA = Nothing
Set xlCellB = Nothing
Set xlCellC = Nothing
End Sub
Private Function FixFormat(ByVal dStr As String) As String
Dim tmpStr As String
Dim i As Integer
For i = 1 To Len(dStr)
If Mid(dStr, i, 1) <> "." Then
tmpStr = tmpStr & Mid(dStr, i, 1)
Else
If Mid(dStr, i + 1, 1) <> " " Then tmpStr = tmpStr & "-"
End If
Next i
FixFormat = tmpStr
End Function
It's not really clear what needs to happen when the 15min threshold is met but this should get you most of the way there:
Sub stackoverflow()
Dim w As Long, Timediff As Double
Dim wb As Workbook, wsData As Worksheet, wsResults As Worksheet, col As Long
Dim baseRow As Range, dataRow As Range, rngData As Range, resultRow As Range
Timediff = 1 / 24 / 4 '(15min = 1/4 of 1/24 of a day)
Set wb = ActiveWorkbook 'or ThisWorkbook
Set wsResults = wb.Worksheets("Results")
'first row for recording results
Set resultRow = wsResults.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow
For w = 3 To wb.Worksheets.Count 'for every sheet from the 3rd to the last
Set rngData = wb.Worksheets(w).Range("A1").CurrentRegion 'whole table
Set rngData = rngData.Offset(1, 0).Resize(rngData.Rows.Count - 1) 'exclude headers
Set baseRow = rngData.Rows(1) 'set comparison row
For Each dataRow In rngData.Rows 'loop over rows in data
If (dataRow.Cells(1).Value - baseRow.Cells(1).Value) > Timediff Then
resultRow.Cells(1).Value = dataRow.Cells(1) 'copy date
For col = 2 To dataRow.Cells.Count 'loop columns and subtract
resultRow.Cells(col).Value = _
dataRow.Cells(col).Value - baseRow.Cells(col).Value
Next col
Set resultRow = resultRow.Offset(1, 0)
Set baseRow = dataRow.Offset(1, 0) 'reset comparison row to next row
End If
Next dataRow
Next w
End Sub
I have two set of range named as LIST_KEY and LIST_CAT. In Column A, user will add some data which will contain one of the one of the text from LIST_KEY. I would like to get corresponding Category list from LIST_CAT depends upon the Key value
I am using below VBA code to achieve this. This include a Array formula.
Sub match()
Dim ss As Workbook
Dim test As Worksheet
Set ss = Excel.Workbooks("test.xlsm")
Set test = ss.Worksheets("Sheet1")
For i = 2 To test.Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "B").FormulaArray = "=INDEX(LIST_CAT,MATCH(TRUE,ISNUMBER(SEARCH(LIST_KEY,RC[-1])),0))"
Cells(i, "B").Formula = Cells(i, "B").Value
Next i
End Sub
This code works perfect if there is less data to fetch. But in my original use case, I will have around 8000 rows. Due to this large number of columns excel will go to not responding state after 2-3 minutes.
Instead of adding Array formula to column B, Is there anyway to convert that into VBA to run this faster. Sorry, I am new to this VBA stuff and dont have much experience
Try the following code, which uses arrays instead of worksheet formulas...
Option Explicit
Sub GetCategories()
Dim sourceWorkbook As Workbook
Set sourceWorkbook = Workbooks("test.xlsm")
Dim sourceWorksheet As Worksheet
Set sourceWorksheet = sourceWorkbook.Worksheets("Sheet1")
Dim lookupArray As Variant
lookupArray = sourceWorkbook.Names("LIST_KEY").RefersToRange.Value
Dim returnArray As Variant
returnArray = sourceWorkbook.Names("LIST_CAT").RefersToRange.Value
Dim tableArray As Variant
Dim lastRow As Long
With sourceWorksheet
lastRow = .Cells(.Rows.Count, "a").End(xlUp).Row
tableArray = .Range("A2:B" & lastRow).Value
End With
Dim desc As String
Dim i As Long
Dim j As Long
For i = LBound(tableArray, 1) To UBound(tableArray, 1)
desc = tableArray(i, 1)
For j = LBound(lookupArray, 1) To UBound(lookupArray, 1)
If InStr(1, desc, lookupArray(j, 1), vbTextCompare) > 0 Then
tableArray(i, 2) = returnArray(j, 1)
Exit For
End If
Next j
Next i
sourceWorksheet.Range("B2").Resize(UBound(tableArray, 1), 1).Value = Application.Index(tableArray, 0, 2)
End Sub
Basically i need to get a list of each different type of issue from the first sheet and then display on the second.
The first sheet has 1 row which is just titles for the columns and then 4 rows with data.
It was wokring but I think i accidently changed something i cant work out whats wrong now, if someone can see an issue or if theres a better way of doing this then im all ears.
Sub ListQueryTypes()
'Create Variables'
Dim numberOfIssues As Integer
Dim numberOfMacroIssues As Integer
Dim numberOfReportIssues As Integer
Dim numberOfTechnicalIssues As Integer
Dim numberOfTrendIssues As Integer
Dim cellValue As String
'Set query register as active worksheet'
Sheets("Query Register").Activate
'set range for search'
Set myRange = Range("G:G")
'Minus 1 for the first row being column name'
numberOfIssues = Application.WorksheetFunction.CountA(myRange)
'Do, for as many issues as were found previously'
For i = 2 To numberOfIssues + 1
cellValue = ActiveSheet.Cells(i, 7).Value
Select Case cellValue
Case "Macro"
numberOfMacroIssues = numberOfMacroIssues + 1
Case "Report"
numberOfReportIssues = numberOfReportIssues + 1
Case "Technical"
numberOfTechnicalIssues = numberOfTechnicalIssues + 1
Case "Trend"
numberOfTrendIssues = numberOfTrendIssues + 1
End Select
Next i
Sheets("Inventory").Activate
ActiveCell = Cells(2, 2)
ActiveCell.Value = numberOfMacroIssues
ActiveCell.Offset(1).Value = numberOfReportIssues
ActiveCell.Offset(2).Value = numberOfTechnicalIssues
ActiveCell.Offset(3).Value = numberOfTrendIssues
To collect all the issues mentioned in the comments, to improve your code. Have a look at the comments in the code
Option Explicit 'force to declare all variables correctly (this way you don't forget any)
Public Sub ListQueryTypes()
'Create Variables'
Dim numberOfIssues As Long 'was Integer but we can always use Long (only advantages) and Excel has more rows than Integer can handle
Dim numberOfMacroIssues As Long
Dim numberOfReportIssues As Long
Dim numberOfTechnicalIssues As Long
Dim numberOfTrendIssues As Long
'Dim cellValue As String 'you don't need that variable see below
'Set query register as active worksheet'
'Sheets("Query Register").Activate 'instead of activate we define that sheet as variable which is more save
'and we use Worksheets
Dim WsQueryReg As Worksheet
Set WsQueryReg = ThisWorkbook.Worksheets("Query Register")
'set range for search'
Dim myRange As Range 'we should to declare all variable properly
Set myRange = WsQueryReg.Range("G:G") 'we need to define in which sheet the range is
'Minus 1 for the first row being column name'
numberOfIssues = Application.WorksheetFunction.CountA(myRange)
'Do, for as many issues as were found previously'
Dim i As Long 'declare every variable first
For i = 2 To numberOfIssues + 1
'cellValue = WsQueryReg.Cells(i, 7).Value 'no need to write this in a variable we can use it directly in Select Case
Select Case WsQueryReg.Cells(i, 7).Value 'was cellValue before
Case "Macro"
numberOfMacroIssues = numberOfMacroIssues + 1
Case "Report"
numberOfReportIssues = numberOfReportIssues + 1
Case "Technical"
numberOfTechnicalIssues = numberOfTechnicalIssues + 1
Case "Trend"
numberOfTrendIssues = numberOfTrendIssues + 1
End Select
Next i
'we can use with instead of activating a sheet and selecting a cell
'this also specifies in which sheet and workbook the cell is
With ThisWorkbook.Worksheets("Inventory").Cells(2, 2)
.Value = numberOfMacroIssues
.Offset(1).Value = numberOfReportIssues
.Offset(2).Value = numberOfTechnicalIssues
.Offset(3).Value = numberOfTrendIssues
End With
End Sub
Instead of looping through your rows For i = 2 To numberOfIssues + 1 you could probably count Macro, Report, etc. like
With WsQueryReg
numberOfMacroIssues = Application.WorksheetFunction.CounfIf(.Range(.Cells(2, 7), .Cells(numberOfIssues + 1, 7)), "Macro")
numberOfReportIssues = Application.WorksheetFunction.CounfIf(.Range(.Cells(2, 7), .Cells(numberOfIssues + 1, 7)), "Report")
'… others here
End With
I would like to export data from a consolidated sheet (DATA) to multiple sheets regarding criteria.
I have a total of 13 criteria, each criteria has to be exported in its dedicated sheet.
I'm trying to optimize this macro (only 2 criteria here) because it lag out
Sub copy()
Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
Dim sh As Worksheet
Dim feuillePrincipale As Worksheet
Dim S01Sheet As Worksheet
Dim S02Sheet As Worksheet
Set feuillePrincipale = ThisWorkbook.Sheets("DATA")
Set S01Sheet = ThisWorkbook.Sheets("S01")
Set S02Sheet = ThisWorkbook.Sheets("S02")
For Each sh In ThisWorkbook.Worksheets
If sh.Name = "S01" Then
i = 2
j = 2
While Not IsEmpty(feuillePrincipale.Cells(i, 1))
If feuillePrincipale.Cells(i, 11).Value Like "S01*" Then
feuillePrincipale.Cells.Rows(i).EntireRow.copy S01Sheet.Rows(j)
j = j + 1
End If
i = i + 1
Wend
End If
If sh.Name = "S02" Then
i = 2
j = 2
While Not IsEmpty(feuillePrincipale.Cells(i, 1))
If feuillePrincipale.Cells(i, 11).Value Like "S02*" Then
feuillePrincipale.Cells.Rows(i).EntireRow.copy S02Sheet.Rows(j)
j = j + 1
End If
i = i + 1
Wend
End If
Next
Application.ScreenUpdating = True
End Sub
If you have any idea, I read I can use Advanced filter but as you guess I'm new in VBA so I'm listening any tips!
Here is the Advanced Filter method you asked for:
Public Sub Christophe()
Const FILTER_COLUMN = 11
Dim i&, rCrit As Range, rData As Range, aShts
aShts = ["SO"&row(1:13)]
Set rData = Sheets("DATA").[a1].CurrentRegion
Set rCrit = rData.Resize(2, 1).Offset(, rData.Columns.Count + 2)
rCrit(1) = rData(1, FILTER_COLUMN)
For i = 1 To UBound(aShts)
rCrit(2) = aShts(i, 1) & "*"
rData.AdvancedFilter xlFilterCopy, rCrit, Sheets(aShts(i, 1)).[a1].Resize(, rData.Columns.Count)
Next
rCrit.Clear
End Sub
The execution time should be instantaneous.
Note: this assumes that you do have 13 criteria, each starting with "SO" and that they occupy column 11 of the Data sheet. It also assumes that you already have 13 sheets named SO1... SO13 in the workbook.
UPDATE
Based on new information that the pattern of the criteria can change, please try this version instead. Note, that it assumes that the sheets already exist and that the sheet names match the criteria:
Public Sub Christophe()
Const FILTER_COLUMN = 11
Dim i&, rCrit As Range, rData As Range, aShts
aShts = Array("SO1", "SO2", "ADQ03", "LocS10")
Set rData = Sheets("DATA").[a1].CurrentRegion
Set rCrit = rData.Resize(2, 1).Offset(, rData.Columns.Count + 2)
rCrit(1) = rData(1, FILTER_COLUMN)
For i = 0 To UBound(aShts)
rCrit(2) = aShts(i) & "*"
rData.AdvancedFilter xlFilterCopy, rCrit, Sheets(aShts(i)).[a1].Resize(, rData.Columns.Count)
Next
rCrit.Clear
End Sub
Try using an array to set your criteria sheets:
Dim shArray As Variant
Dim shArrayString As String
Dim feuillePrincipale As Excel.Worksheet
Dim i As Long
Dim j As Long
Set feuillePrincipale = ThisWorkbook.Sheets("DATA")
j = 1
'// Create array and populate
shArray = Array("S01", "S02", "S03", "S04") '// add as required
'// Create string representation of array
shArrayString = "{"""
For i = LBound(shArray) To UBound(shArray)
shArrayString = shArrayString & shArray(i) & ""","""
Next
shArrayString = Left(shArrayString, Len(shArrayString) - 2) & "}"
'//Start loop
With feuillePrincipale
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Not Evaluate("ISERROR(MATCH(" & Left(.Cells(i, 11), 3) & "," & shArrayString & ",0))") Then
.Rows(i).Copy Sheets(shArray(WorksheetFunction.Match(Left(.Cells(i, 11), 3), shArray, 0))).Cells(j, 1)
j = j + 1
End If
Next
End With
It's a bit unclear because if you follow the code you've posted - it's actually just copying and pasting data to the same sheet...
Yes, you should use an autofilter and use a special select to get only the visible cells.
If you want the loop method, you should loop through each row on sheets("DATA") and use a Select Case Statement to decide onto which sheet the data is placed.
By looping through each sheet you are adding loops that will slow it down.
Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
Dim cel As Range
Dim sh As Worksheet
Dim feuillePrincipale As Worksheet
Dim S01Sheet As Worksheet
Dim S02Sheet As Worksheet
Set feuillePrincipale = ThisWorkbook.Sheets("DATA")
Set S01Sheet = ThisWorkbook.Sheets("S01")
Set S02Sheet = ThisWorkbook.Sheets("S02")
For Each cel In feuillePrincipale.Range(feuillePrincipale.Range("A1"), feuillePrincipale.Range("A1").End(xlDown))
Select Case Left(cel.offset(,10).value, 3)
Case "S01"
j = S01Sheet.Range("A" & Rows.count).End(xlUp).Offset(1).Row
feuillePrincipale.Cells.Rows(cel.Row).EntireRow.copy S01Sheet.Rows(j)
Case "S02"
j = S02Sheet.Range("A" & Rows.count).End(xlUp).Offset(1).Row
feuillePrincipale.Cells.Rows(cel.Row).EntireRow.copy S02Sheet.Rows(j)
'Case .... keep adding select statement till you get to the last condition
Case Else
End Select
Next cel
Application.ScreenUpdating = True
I want to compare the content of two ranges in a worksheet to two strings on another worksheet. In the case of both conditions are met, the cell next to it has to be summes up with all prior matches.
The code that works fine with comparing it to one criteria:
Sub Makro1()
Dim FB As String
FB = ActiveWorkbook.Sheets("Form").Range("B3").Value
Dim MyRangeA As Range
Dim A As Range
Dim MyTotal As Long
Dim LastRow As Long
MyTotal = 0
LastRow = ActiveWorkbook.Sheets("Downloads").Cells(Cells.Rows.Count, "F").End(xlUp).Row
Set MyRangeA = ActiveWorkbook.Sheets("Downloads").Range("F3:F" & LastRow)
For Each A In MyRangeA
If A.Value = FB Then
MyTotal = MyTotal + A.Offset(, 1).Value
End If
ActiveWorkbook.Sheets("Downloads").Range("K3") = MyTotal
Next
End Sub
However, I just cannot figure out how to insert another criteria to my range. This is my current try that doesn't work:
Sub Macro1()
Dim FB As String
Dim MTH As String
FB = ActiveWorkbook.Sheets("Form").Range("B3").Value
MTH = ActiveWorkbook.Sheets("Form").Range("B5").Value
Dim MyRangeA As Range
Dim A As Range
Dim MyRangeB As Range
Dim B As Range
Dim MyTotal As Long
Dim LastRow As Long
MyTotal = 0
LastRow = ActiveWorkbook.Sheets("Downloads").Cells(Cells.Rows.Count, "F").End(xlUp).Row
Set MyRangeA = ActiveWorkbook.Sheets("Downloads").Range("F3:F" & LastRow)
Set MyRangeB = ActiveWorkbook.Sheets("Downloads").Range("D3:D" & LastRow)
For Each A In MyRangeA
For Each B In MyRangeB
If B.Value = MTH Then
MyTotal = MyTotal + A.Offset(, 1).Value
End If
Next
ActiveWorkbook.Sheets("Downloads").Range("L3") = MyTotal
Next
End Sub
Can anyone help my out with this one?
As Charles Williams wrote you could use SUMIFS. You can use it within your VBA routine if you are happy with case insensitive matching:
MyTotal = WorksheetFunction.SumIfs(MyRangeA.Offset(, 1), MyRangeA, FB, MyRangeB, MTH)
Or, if that is problematic, you could loop testing each item. However, depending on the size of your data, it is usually measurably faster to read everything into a VBA array, and loop through that, rather than going back to the worksheet for each item. In addition, it is generally faster to iterate by index For I = 1 to n ... Next I than to go through a For Each Someobject ... Next Someobject type of iteration. So if you did not want to use the above, I would try a code snippet similar to:
Dim I As Long
Dim vData As Variant
vData = Union(MyRangeA, MyRangeA.Offset(, 1), MyRangeB)
For I = 1 To UBound(vData)
If vData(I, 1) = FB And vData(I, 3) = MTH Then
MyTotal = MyTotal + vData(I, 2)
End If
Next I
Depending on your requirements, you might also, for the latter, consider adding
Option Compare Text
to the top of your macro.