Related
can someone please look into my code and say me where is the mistake cause I got a type mismatch error message ? With this code I would like to delete all rows who which contain "0" in the respective cells.
I got the error message for the line where is standing: sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:8))])
Also I had to declare the variable "c00" and I choosed "c00 As Variant". I don't know if it its correct. I would appreciate someone helping me to solve the problem.
Dim sn As Variant, c00 As Variant
sn = Sheets(1).UsedRange
For j = 1 To UBound(sn)
If sn(j, 4) & sn(j, 5) & sn(j, 6) & sn(j, 7) & sn(j, 8) & sn(j, 9) = "000000" Then c00 = c00 & "|" & j
Next
If c00 <> "" Then
sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:8))])
Sheets(1).UsedRange.ClearContents
Sheets(1).Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End If
Original Code
Dim LR%
LR = Cells(Rows.Count, 3).End(xlUp).Row
Set Myrange = Range("D2:AO" & LR).SpecialCells(xlCellTypeBlanks) 'nur Leerzellen
Myrange.Formula = "0"
ActiveSheet.UsedRange
Set r = ActiveSheet.UsedRange
lastrow3 = r.Rows.Count + r.Row - 1
For j = lastrow3 To 1 Step -1
If (Cells(j, 4) = 0 And Cells(j, 5) = 0 And Cells(j, 6) = 0 And Cells(j, 7) = 0 And Cells(j, 8) = 0 And Cells(j, 9) = 0) Then
Rows(j).Delete
End If
Next j
Image w/ Error
Edit: the error was from attempting to use Application.Index on an array larger than the function size limit. Redirect to here for Q&A an on alternative option to Application.Index.
I'll break down my analysis of your code:
Application.Index(Array, Row_Number, Column_Number)
The code you currently have:
sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), [transpose(row(1:8))])
is saying that the parameters are:
Array: sn
Row_Number: Application.Transpose(Split(Mid(c00, 2), "|"))
Column_Number: [transpose(row(1:8))]
The Array section looks fine to me. The Row numbers will, I think(?), be the values for j which you collected in c00 (although the Application.Transpose may not be necessary Correction: it is in this scenario.). I have no idea what is going on with your Column_Number parameter....
Issues:
Application.Index keeps the selected columns/rows. However, your if statement selects the values of j where the rows are entirely 0, so instead of losing them, you would be keeping only those rows.
If your intention is to keep all the columns, you can just input 0 into the Column_Number parameter. Correction: this works when only selecting a single row to keep. If selecting multiple rows, all columns must be listed as well.
Corrected code:
Since this code does delete data, you should save a copy of the data before running this code on it.
Note: c00 can be a Variant; String also works. You will need to also copy over the fillA function, as well.
Dim sn As Variant, c00 As String
sn = Sheets(1).UsedRange
' Changed condition based on your post with previous code. (And negated)
For j = 1 To UBound(sn)
If Not ((Cells(j, 4) = 0 And Cells(j, 5) = 0 And Cells(j, 6) = 0 And Cells(j, 7) = 0 And Cells(j, 8) = 0 And Cells(j, 9) = 0)) Then c00 = c00 & "|" & j
Next
If c00 <> "" Then
' Corrected inputs for Application.Index, Added helper function "fillA".
sn = Application.Index(sn, Application.Transpose(Split(Mid(c00, 2), "|")), fillA(1, UBound(sn, 2) - LBound(sn, 2) + 1))
Sheets(1).UsedRange.ClearContents
Sheets(1).Cells(1).Resize(UBound(sn), UBound(sn, 2)) = sn
End If
Function fillA(min As Long, max As Long) As Variant
Dim var() As Variant, i As Long
ReDim var(1 To max - min + 1)
For i = min To max
var(i) = i + min - 1
Next i
fillA = var
End Function
Edit:
Realized this did not address your issue. I suspect that the error was from the [transpose(row(1:8))] you were inserting for the Column_Number parameter.
Maybe someone else has a simpler way of doing what I did with the fillA function (what I believe you were attempting).
I have a function that checks the rows underneath the current one depending on the unique ID. There can be up to 6 unique ideas under the current record (loop variable = i) that match the current record being checked in the loop. After this is done, the records underneath are checked for specific conditions (loop variable x). However, for some reason, I'm running into several issues. The first is that I had to set the range references inside of both loops, otherwise I got an error. The second is that, all of the stuff after the x loop seems to be outputting in the i loop that came before it. What am I doing wrong, and how can i make this function properly?
Please find my code below:
Function First_check()
dim i as long, x as long
Dim numComponents As Variant
Dim in1 As Range, in2 As Range, in3 As Range, in4 As Range, in5 As Range, _
in6 As Range, in7 As Range, in8 As Range, in9 As Range, in10 As Range, _
in11 As Range, in12 As Range, in13 As Range, in14 As Range, in15 As Range, _
in16 As Range, in17 As Range, in18 As Range, in19 As Range, in20 As Range
Dim out1 As Range, out2 As Range, out3 As Range, out4 As Range, out5 As Range, _
out6 As Range, out7 As Range, out8 As Range, out9 As Range, out10 As Range, _
out11 As Range, out12 As Range, out13 As Range, out14 As Range, out15 As Range, _
out16 As Range, out17 As Range, out18 As Range, out19 As Range, out20 As Range
Dim str, msg, oft, BTG, LOB, pdf, mht, emails, zip_rar, xls, doc, xls_doc, mrTT, lobVal, cmt1, giveURL, giveURLm As String
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastRow
If Cells(i, 5).Value2 = Cells(i + 6, 5).Value2 Then
numComponents = 6
ElseIf Cells(i, 5).Value2 = Cells(i + 5, 5).Value2 Then
numComponents = 5
ElseIf Cells(i, 5).Value2 = Cells(i + 4, 5).Value2 Then
numComponents = 4
ElseIf Cells(i, 5).Value2 = Cells(i + 3, 5).Value2 Then
numComponents = 3
ElseIf Cells(i, 5).Value2 = Cells(i + 2, 5).Value2 Then
numComponents = 2
ElseIf Cells(i, 5).Value2 = Cells(i + 1, 5).Value2 Then
numComponents = 1
Else
numComponents = 0
End If
For x = i + 1 To i + numComponents
Set in1 = Cells(i, 11) 'test
Set in2 = Cells(i, 12)
Set in3 = Cells(i, 13)
Set in4 = Cells(i, 16) 'e
Set in5 = Cells(i, 37) 'target date
Set in6 = Cells(i, 38) 'target date end
Set in7 = Cells(i, 35) 'target date actual
Set in8 = Cells(i, 37) 'target date start
Set in9 = Cells(i, 38) 'target date end
Set in10 = Cells(x, 50) ' date start
Set in11 = Cells(x, 51) ' date end
Set in12 = Cells(i, 42) 'pro
Set in13 = Cells(i, 43) 'reco
Set in14 = Cells(x, 62) 'cert
Set in15 = Cells(x, 63) 'com
Set in16 = Cells(x, 64) 'comp
Set in17 = Cells(x, 49) 'uniqueID
'outs
Set out1 = Cells(i, 72) 'test
Set out2 = Cells(i, 73) '
Set out3 = Cells(i, 74) '
Set out4 = Cells(i, 75) 'e
Set out5 = Cells(i, 76) 'tar
Set out6 = Cells(i, 77) 'comp
Set out7 = Cells(i, 78) 'pro
Set out8 = Cells(i, 75) 'empty
Set out9 = Cells(i, 80) 'cer
Set out10 = Cells(i, 81) 'comp
Set out11 = Cells(i, 85) 'pre
Set out12 = Cells(i, 88) 'missing
Set out13 = Cells(i, 89) 'missing2
Set out14 = Cells(i, 71) 'uniqueID
'------ATTACHMENT SET
str = Cells(i, 46).Value2
msg = UBound(Split(str, ".msg"))
oft = UBound(Split(str, ".oft"))
BTG = UBound(Split(str, "BTG"))
LOB = UBound(Split(str, "LOB"))
pdf = UBound(Split(str, ".pdf"))
mht = UBound(Split(str, ".mht"))
emails = msg + oft + pdf + mht
zip_rar = UBound(Split(str, ".zip"))
xls = UBound(Split(str, ".xls"))
doc = UBound(Split(str, ".doc"))
xls_doc = xls Or doc
If (in8.Value2 <> in10.Value2) Or (in9.Value <> in11.Value2) Then 'date
out6.Value2 = Cells(x, 49).Value2 & ", " & out6.Value2
End If
If IsBlank(in14.Value2) Then 'Check cer
out9.Value2 = Cells(x, 49).Value2 & ", " & out9.Value2
End If
If IsBlank(in15.Value2) Or IsBlank(in16.Value2) Then 'check loc
out10.Value2 = Cells(x, 49).Value2 & ", " & out10.Value2
End If
If Not IsBlank(in17.Value2) Then
out14.Value2 = in17.Value2 & ", " & out14.Value2
End If
Next x
If Not IsBlank(out6.Value2) Then 'date
out6.Value2 = "Wrong dates"
out6.Value2 = fixtrail(out6.Value2)
End If
If Not IsBlank(out9.Value2) Then 'cert
out9.Value2 = "Cert Issue"
out9.Value2 = fixtrail(out9.Value2)
End If
If Not IsBlank(out10.Value2) Then 'comp
out10.Value2 = "Comp not found"
out10.Value2 = fixtrail(out10.Value2)
End If
If IsBlank(in1.Value2) Then
out1.Value2 = "Missing type"
End If
'
'many more checks happening that i omittied for brevity
'
If numComponents = 0 Then
Cells(i, 70).Value2 = "0"
Else
Cells(i, 70).Value2 = numComponents
End If
i = i + numComponents
Next i
End Function
The first idea that came to mind is using an array of Range objects to clean up the variable declarations:
Dim inRange(20) As Range
Dim outRange(20) As Range
'...
For x = i + 1 To i + numComponents
Set inRange(1) = Cells(i, 11)
Set inRange(2) = Cells(i, 12)
'...
Next
This will work especially well if you can get a formula for the cell numbers that map to each array position.
Additionally, we can improve variables around how the two loops are nested. The outer loop uses the i variable, while the inner loop uses the x variable. Since these are both looking at rows, I would re-name them as r0 and r1 (or rBase and rNested, rParent and rChild, rMaster and rDetail, etc) to help you understand what you're looking at with each index. I also see that some of the Range objects depend on the current i value, while other depend on x. You should be able to assign the i ranges above the inner loop, and save some CPU/memory work that way:
For irParent = 2 To LastRow
'...
Set inRange(1) = Cells(irParent, 11) 'test
Set inRange(2) = Cells(irParent, 12)
Set inRange(3) = Cells(irParent, 13)
Set inRange(4) = Cells(irParent, 16) 'e
'...
'If numComponents is 0, there are no child rows and this loop is skipped
For rChild = rParent + 1 To rParent + numComponents
Set inRange(10) = Cells(irChild, 50) ' date start
Set inRange(11) = Cells(irChild, 51) ' date end
'...
str = Cells(irParent, 46).Value2
msg = UBound(Split(str, ".msg"))
oft = UBound(Split(str, ".oft"))
'...
Next
irParent = irParent + numComponents
Next
Another thing is this method runs kind of long. You may want to abstract out some of the checks to a separate method, or a few separate methods that depend on what type of parent record you're looking at. Create methods that just accept the values needed for checking a particular kind of row, and then returns a single result for the check. This adds names to the code that help you understand what you're doing, as well as shorting the parent code to make it easier to read and understand at a high level more quickly.
As you make those other changes, you may want to start thinking in terms of creating Range objects that represent an entire row (or section from a row), so you can pass them to methods. This is especially true, as it appears many Range objects are currently used to hold values from single Cells. You can build strings to define non-contiguous Ranges that have the values needed for each row (including the parent cells when working in a child row). This will make building functions much easier, if you can have them simply accept a single Range object that you know has the correct cells in it.
This is also helpful because it minimizes instances where you copy from Excel Cells to memory. Moving data between VBA and Excel is a costly operation. It's usually better for performance to copy to or from a set of Cells in bulk, rather than one Cell at a time. This often holds even when it means using some extra memory. It also often helps reduce or simplify the total amount of code needed. Unfortunately, I'm too far out of VBA to show you an example.
Finally, notice my indentation. Professionals will do that consistently... even religiously. "Hacky" code does not. It's extremely helpful for spotting mistakes.
Issue: Item is in VLOOKUP table, but is returning the value of "Missing" in the appropriate cell. When conUD prints if I copy paste it from the Debug window and Ctrl+F - find it on the J column it finds it without issue. Why would it be found by Ctrl+F and not VLookup?
Notes:
This is only the relevant code, not the entire chunk.
lrVelocity is calculating correctly. Value is 1,951 .
The values are of the form 0001HCM8889W01 and thus do not violate the VLOOKUP max characters restriction.
As you can see I tried to trim any invisible spaces as well as ensured they were both strings.
I am reasonably new to VBA and appreciate any and all help with this issue. I read multiple Google articles, but none of those fixes solved my issue.
Option Explicit
Dim wsMain As Worksheet
Dim wsQuantity As Worksheet
Dim wsVelocity As Worksheet
Dim wsParameters As Worksheet
Dim wsData As Worksheet
Dim lrMain As Long 'lr = last row
Dim lrQuantity As Long
Dim lrVelocity As Long
Dim lrParameters As Long
Dim lrData As Long
Dim conUD As String 'con=concatenate
Dim conECD As String
Dim calcWeek As Long
Dim RC As Long 'Row Counter
Dim vl As Variant 'Vlookup, Variant to allow for errors without breaking the code
calcWeek = wsParameters.Range("B3").Value
lrVelocity = wsVelocity.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
Set wsMain = Worksheets("Main Tab")
Set wsVelocity = Worksheets("Velocity")
For RC = 2 To 10 'lrVelocity
With wsVelocity
.Cells(RC, 10) = .Cells(RC, 1) & .Cells(RC, 1) & .Cells(RC, 4) & .Cells(RC, 5) & .Cells(RC, 9)
.Cells(RC, 10).Value = CStr(Trim(.Cells(RC, 10).Value))
.Cells(RC, 11) = .Cells(RC, 6)
.Cells(RC, 12) = .Cells(RC, 7)
.Cells(RC, 13) = .Cells(RC, 8)
.Cells(RC, 14) = .Cells(RC, 3)
.Cells(RC, 22) = .Cells(RC, 1) & .Cells(RC, 9)
End With
Next RC
For RC=2 To 10
conUD = wsMain.Cells(RC, 21) & wsMain.Cells(RC, 4) & calcWeek
conUD = CStr(Trim(conUD))
Debug.Print conUD
wsVelocity.Activate
vl = Application.VLookup(conUD, wsVelocity.Range(wsVelocity.Cells(2, 10), wsVelocity.Cells(lrVelocity, 11)), 2, False)
If IsError(vl) Then
wsMain.Cells(RC, 10).Value = "Missing"
Else
wsMain.Cells(RC, 10).Value = vl
End If
Next RC
I think #user1274820 is on to something. Normally we use Application.Vlookup as you're using, with the anticipation that perhaps the value will not be found in the first column of table_array, and you want to handle that with "Missing" value in the output.
HOWEVER, if the value is found, but the value in the return column (k, in your case) is an error, then the function will return the error as well. In your case, while the value is found in column J, it would seem that column K contains an #N/A. (Let me know if this is not the case!)
Application.Vlookup returns an Error 2042 in both of these cases:
lookup_value is not found in the first column of table_array (most common usage & expectation, IMO)
lookup_value IS found, but the resulting value from col_index_num is itself an error.
So, if the return value might contain an error even if the lookup value exists, then we can't use Application.Vlookup to test for the presence of the value, but you can use an alternate method like WorksheetFunction.CountIf or Application.Match.
Here, we simply query the column J and use CountIf to ensure there's at least 1 matching value. This will validate our Vlookup in advance, but we still need to handle the possible error in the return value.
For RC = 2 to 10
conUD = wsMain.Cells(RC, 21) & wsMain.Cells(RC, 4) & calcWeek
conUD = CStr(Trim(conUD))
Debug.Print conUD
With wsVelocity
Dim lookupRange as Range
Set lookupRange = .Range(.Cells(2, 10), .Cells(lrVelocity, 11))
End With
If Application.WorksheetFunction.CountIf(lookupRange.Columns(1), conUD) <> 0 Then
'The value is found, it should be safe to use VLOOKUP
vl = Application.VLookup(conUD, lookupRange, 2, False)
'## Handles an error in the return value from the return column
If IsError(vl) Then
'## Copies the error from return column, or modify as needed
wsMain.Cells(RC, 10).Value = CVerr(vl)
Else
'## Value found in Col J and return Vlookup from Col K
wsMain.Cells(RC, 10).Value = vl
End If
Else
'## Value NOT FOUND in column J
wsMain.Cells(RC, 10).Value = "Missing"
End If
Next
Update
From chat, I can see the formatting of your Main and Lookup tables values is different. In your lookup table, you're duplicating a prefix e.g., "0001HCM8889" and so you end up with "0001HCM8890001HCM889W01".
This is why Find or Ctrl+F will find the cell, but VLOOKUP won't, because it's requiring an exact match.
As it appears you're constructing/sanitizing the lookup table in your first loop, you should be able to fix it by doing this:
For RC = 2 To 10 'lrVelocity
With wsVelocity
'## Removed the duplicate .Cells(RC, 1) from the next line ##
.Cells(RC, 10) = .Cells(RC, 1) & .Cells(RC, 4) & .Cells(RC, 5) & .Cells(RC, 9)
.Cells(RC, 10).Value = CStr(Trim(.Cells(RC, 10).Value))
.Cells(RC, 11) = .Cells(RC, 6)
.Cells(RC, 12) = .Cells(RC, 7)
.Cells(RC, 13) = .Cells(RC, 8)
.Cells(RC, 14) = .Cells(RC, 3)
.Cells(RC, 22) = .Cells(RC, 1) & .Cells(RC, 9)
End With
Next RC
I cannot seem to solve this VBA riddle I've been working on, please help. I'm new at this and I'm probably over complicating it
Essentially, there are two worksheets - one titled Master and the other will be created fresh daily by date. The Master tab contains 10000 rows of historical data filled from Columns A:X. The other tab generally has about 300 rows of fresh data and also contains like Columns A:X, only with blank cells in Columns A:B. I'm trying to find matches with the master tab, and if so, populate the corresponding results in cells A and B from the master to the daily. If nothing, leave blank. It is crucial that Cells H:M and R:W are identical matches.
Below is my crazy attempt, Thank you in advance for helping
Sub Previous()
Dim u As Long
u = 2
Do While ActiveSheet.Cells(u, 6) <> ""
Dim i As Long
i = 2
Do While Worksheets("Master").Cells(i, 6) <> ""
If ActiveSheet.Range(Cells(u, 8), Cells(u, 13)) _
= Worksheets("Master").Range(Cells(i, 8), Cells(i, 13)) _
And ActiveSheet.Range(Cells(u, 18), Cells(u, 23)) _
= Worksheets("Master").Range(Cells(i, 18), Cells(i, 23)) _
And ActiveSheet.Cells(u, 2) = "" Then
ActiveSheet.Range(Cells(u, 1), Cells(u, 2)) _
= Worksheets("Master").Range(Cells(i, 1), Cells(i, 2))
Else: i = i + 1
End If
Loop
u = u + 1
i = 2
Loop
End Sub
First of all, I don't believe this snippet does what you think it does.
Worksheets("Master").Range(Cells(i, 8), Cells(i, 13))
In that snippet Cells(i,8) references the ActiveSheet, not Sheets("Master").
There is a note on this about halfway down the page on msdn's Range Object documentation.
You can simplify your code a great deal by assigning some worksheet variables.
dim actWs as Worksheet
dim mstWs as Worksheet
Set actWs = Activesheet
Set mstWs = Sheets("Master")
'then reference your ranges like this
mstWs.Cells(i,8)
But, that's not what is causing your runtime error.
Simply put, you can not compare ranges that way. You need to check the value of each cell, so you end up with another layer of nested loops.
dim u as long ' active sheet row counter
dim i as long ' master sheet row counter
dim c as long ' column counter
For u = 2 to actWs.Range("A" & .Rows.Count).End(xlUp).Row 'find last row in column "A" of active sheet
For i = 2 to mstWs.Range("A" & .Rows.Count).End(xlUp).Row 'find last row in column "A" of master sheet
For c = 8 to 13
If actWs.Cells(i,c) = mstWs.Cells(i,c) Then
'Do stuff
End if
next c 'next column
next i 'next master sheet row
next u 'next active sheet row
This is obviously a simplified version of what you'll need to do. Be careful of line continuations (" _ ") and code indentation. It's easy to trick yourself into thinking your program should flow in a way that it isn't. It would be advisable to store the value's you're checking for equality in variables to make it easier to read. You might more readily notice where you're going wrong.
Sub Previous()
Dim actWs As Worksheet
Set actWs = ActiveSheet
Dim mstWs As Worksheet
Set mstWs = Sheets("Master")
Dim u As Long
Dim i As Long
u = 2
Do While actWs.Cells(u, 6) <> ""
For i = 2 To mstWs.Range("C" & Rows.Count).End(xlUp).Row
If actWs.Cells(u, 8) = mstWs.Cells(i, 8) And actWs.Cells(u, 9) = mstWs.Cells(i, 9) And actWs.Cells(u, 10) = mstWs.Cells(i, 10) And actWs.Cells(u, 11) = mstWs.Cells(i, 11) And actWs.Cells(u, 12) = mstWs.Cells(i, 12) And actWs.Cells(u, 13) = mstWs.Cells(i, 13) And actWs.Cells(u, 18) = mstWs.Cells(i, 18) And actWs.Cells(u, 19) = mstWs.Cells(i, 19) And actWs.Cells(u, 20) = mstWs.Cells(i, 20) And actWs.Cells(u, 21) = mstWs.Cells(i, 21) And actWs.Cells(u, 22) = mstWs.Cells(i, 22) And actWs.Cells(u, 23) = mstWs.Cells(i, 23) Then
mstWs.Select
Range(Cells(i, 1), Cells(i, 2)).Select
Selection.Copy
actWs.Select
Range(Cells(u, 1), Cells(u, 2)).Select
actWs.Paste
End If
Next i
u = u + 1
Loop
End Sub
I was running a VBA code in Excel 2007. I got the above mention run/Application error of 1004.
My code is
Public Sub LblImport_Click()
Dim i As Long, j As Long
Dim vData As Variant, vCleanData As Variant, vFile As Variant, sMarket As String
Dim wbkExtract As Workbook, sLastCellAddress As String, month As String
Dim cnCountries As New Collection
Application.ScreenUpdating = False
' Get the name of the Dataview Extract file to transform and the market name
vFile = "D:\DRX\" & "Norvasc_Formatted.xlsx"
sMarket = "Hypertension"
ThisWorkbook.Worksheets("Control").Range("TherapeuticMarket").Value = "Hypertension"
' Clear all existing data from this workbook
ThisWorkbook.Worksheets("RawData").Cells.ClearContents
' Create labels in Raw Data Sheet
ThisWorkbook.Worksheets("RawData").Cells(1, 1).Value = "Therapy Market"
ThisWorkbook.Worksheets("RawData").Cells(1, 2).Value = "Country"
ThisWorkbook.Worksheets("RawData").Cells(1, 3).Value = "Brand"
ThisWorkbook.Worksheets("RawData").Cells(1, 4).Value = "Corporation"
ThisWorkbook.Worksheets("RawData").Cells(1, 5).Value = "Molecule"
' Open Dataview extract, copy and clean data
Set wbkExtract = Workbooks.Open(vFile)
i = 2
Do While wbkExtract.ActiveSheet.Cells(1, i).Value <> ""
If UCase(Mid(wbkExtract.ActiveSheet.Cells(1, i).Value, 1, 3)) = "TRX" Then
month = Split(wbkExtract.ActiveSheet.Cells(1, i).Value, "/")(1)
If Len(month) = 1 Then
month = "0" + month
End If
ThisWorkbook.Worksheets("RawData").Cells(1, i + 4).Value = Mid(wbkExtract.ActiveSheet.Cells(1, i).Value, 1, 10) + month + "/" + Mid(Split(wbkExtract.ActiveSheet.Cells(1, i).Value, "/")(2), 3, 2)
End If
If UCase(Mid(wbkExtract.ActiveSheet.Cells(1, i).Value, 1, 3)) = "LCD" Then
month = Split(wbkExtract.ActiveSheet.Cells(1, i).Value, "/")(2)
If Len(month) = 1 Then
month = "0" + month
End If
ThisWorkbook.Worksheets("RawData").Cells(1, i + 4).Value = Mid(wbkExtract.ActiveSheet.Cells(1, i).Value, 1, 14) + month + "/" + Mid(Split(wbkExtract.ActiveSheet.Cells(1, i).Value, "/")(3), 3, 2)
End If
i = i + 1
Loop
wbkExtract.ActiveSheet.Cells(1, 1).EntireRow.Delete
vData = wbkExtract.ActiveSheet.Cells(1, 1).CurrentRegion.Value
wbkExtract.Close savechanges:=False
vCleanData = CleanRawData(vData, sMarket)
sLastCellAddress = ThisWorkbook.Worksheets("RawData").Cells(UBound(vCleanData, 1) + 1, UBound(vCleanData, 2)).Address(RowAbsolute:=False, ColumnAbsolute:=False)
ThisWorkbook.Worksheets("RawData").Range("A2:" & sLastCellAddress).Value = vCleanData
' Get List of Unique Countries
On Error Resume Next
For i = 1 To UBound(vCleanData, 1)
cnCountries.Add vCleanData(i, 2), vCleanData(i, 2)
Next i
On Error GoTo 0
ThisWorkbook.Worksheets("Market").Cells(1, 1).CurrentRegion.Clear
ThisWorkbook.Worksheets("Market").Cells(1, 1).Value = "Country"
ThisWorkbook.Worksheets("Market").Cells(1, 2).Value = "Group 1"
ThisWorkbook.Worksheets("Market").Cells(1, 3).Value = "Group 2"
ThisWorkbook.Worksheets("Market").Cells(1, 4).Value = "Group 3"
ThisWorkbook.Worksheets("Market").Cells(1, 5).Value = "Group 4"
ThisWorkbook.Worksheets("Market").Range("A1:G1").Font.Bold = True
For i = 1 To cnCountries.Count
ThisWorkbook.Worksheets("Market").Cells(i + 1, 1).Value = cnCountries.Item(i)
Next i
End Sub
Sounds like a broken code cache.
I've seen errors happen like this before in older format (xls) workbooks and it can be a sign of problems in the file overall.
Try the compile option suggested by #Scott Holtzman first. In some cases I've seen the recompile not work and if that happens just force a compile by making a change to the code. A trivial change is enough usually.
If that doesn't work then (to help disagnose a corruption issue) try copying the code into a new workbook and see what happens there. If it runs in the new sheet then I wouldn't waste more time on it and just rebuild the sheet, trust me it'll be quicker than messing about troublshooting the one you have.