Why am I receiving Error 1004 when trying to specify the loop variable in a cell reference? - excel

I am stuck, primarily because I am still brand spanking new at VBA. As such, I really appreciate any help you can lend me. I have looked through many other Error 1004 posts on here, but they were either for different issues, or it is quite possible that I am just too ignorant to know what to do with the advice in them.
My issue is this: I have two workbooks, one with raw data, and one in which the raw data is consolidated into relevant statistics. I am trying to sumif the data in X:X in my raw workbook (6620) by two criteria in the statistics book and then update the value in the corresponding cell in the statistics book.
I am running into a Run-time Error 1004: Application-defined or object-defined error at the indicated points. I am lost as to how to move past this.
Any help is greatly appreciated!
This is as far as I have gotten:
Option Explicit
Sub ImportFTEs()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim ws As Integer
Workbooks.Open Filename:=ActiveWorkbook.Path & "\6620\FY19*.xlsb"
For ws = 1 To Worksheets.Count
Sheets(ws).Name = "Sheet1"
Next ws
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim totalFTE As Long
Dim lastRow As Integer
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
Dim wb As Worksheet
Set wb = Workbooks.Open(ActiveWorkbook.Path & "\FY19*.xlsb").Sheets("Sheet1")
Dim wc As Worksheet
Set wc = ThisWorkbook.Sheets("B")
Dim sum1R As Range
Set sum1R = wb.Range("X:X")
Dim arg2R As Range
Set arg2R = wb.Range("D:D")
Dim arg2C As Range
Set arg2C = wc.Cells(7, i)
>>> Error 1004
Dim arg3R As Range
Set arg3R = wb.Range("S:S")
Dim arg3C As Range
Set arg3C = wc.Cells(j, 6)
>>> Error 1004
For k = 8 To 18
For l = 7 To 18
For i = 7 To 18
For j = 8 To 18
wc.Cells(k, l).value = Application.WorksheetFunction.SumIfs(sum1R, arg2R, arg2C, arg3R, arg3C)
Next j
Next i
Next l
Next k
ActiveWorkbook.Close savechanges:=True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Should be something like this - you need the Set lines containing i and j inside their respective loops - that way the values actually increment (and aren't 0 when they're initialized):
Option Explicit
Sub ImportFTEs()
Application.ScreenUpdating = False
Application.EnableEvents = False
Workbooks.Open Filename:=ActiveWorkbook.Path & "\6620\FY19*.xlsb"
Dim i As Long, j As Long, k As Long, l As Long
Dim totalFTE As Long
Dim wb As Worksheet
Set wb = Workbooks.Open(ActiveWorkbook.Path & "\FY19*.xlsb").Sheets("Sheet1")
Dim wc As Worksheet
Set wc = ThisWorkbook.Sheets("B")
Dim sum1R As Range
Set sum1R = wb.Range("X:X")
Dim arg2R As Range
Set arg2R = wb.Range("D:D")
Dim arg3R As Range
Set arg3R = wb.Range("S:S")
Dim arg2C As Range
Dim arg3C As Range
For k = 8 To 18
For l = 7 To 18
For i = 7 To 18
Set arg2C = wc.Cells(7, i)
For j = 8 To 18
Set arg3C = wc.Cells(j, 6)
wc.Cells(k, l).Value = Application.WorksheetFunction.SumIfs(sum1R, arg2R, arg2C, arg3R, arg3C)
Next j
Next i
Next l
Next k
ActiveWorkbook.Close True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Related

How to avoid error #NA when executing my macro

I have this error with my macro. My macro takes data from a table and in another sheet, outputs in a table my data for each value of a third sheet.
So let's say my table's value are : Jack and Daniel. And on my third sheet, I have Football and Rugby. The output in the second page will be :
Jack Football
Jack Rugby
Daniel Football
Daniel Rugby
Here is my macro :
Sub yo()
Dim Letters, Chk, Ele As Range, i As Long: Letters = Sheets("Sports").Range("C3:C5").Value
For Each Ele In Sheets("Students").ListObjects(1).ListColumns(1).DataBodyRange
With Sheets("OK").ListObjects(1)
Chk = Application.Match(Ele, .ListColumns(1).Range, 0)
If IsError(Chk) Then
For i = 1 To 3
.ListRows.Add.Range = Array(Ele, Letters(i, 1))
Next i
End If
End With
Next Ele
End Sub
However this works fine. The problem comes from all the other columns of the table in my second sheet. They all get the value "#NA". So instead of having nothing or formulas expanding down, there is that error.
How can I overcome this error ?
Copy to Excel Table (ListObject)
The short answer is that in this case a ListRow has four columns yet you're assigning it an array of only two. By the looks of your answer, you have concluded this yourself (.Resize(, 2)).
An Improvement
Option Explicit
Sub AddStudents()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim wsSports As Worksheet: Set wsSports = wb.Sheets("Sports")
Dim Sports(): Sports = wsSports.Range("C3:C5").Value
Dim SportsCount As Long: SportsCount = UBound(Sports, 1)
Dim wsStudents As Worksheet: Set wsStudents = wb.Sheets("Students")
Dim loStudents As ListObject: Set loStudents = wsStudents.ListObjects(1)
Dim lcStudents As ListColumn: Set lcStudents = loStudents.ListColumns(1)
Dim rgStudents As Range: Set rgStudents = lcStudents.DataBodyRange
Dim wsOK As Worksheet: Set wsOK = wb.Sheets("OK")
Dim loOK As ListObject: Set loOK = wsOK.ListObjects(1)
Dim lcOK As ListColumn: Set lcOK = loOK.ListColumns(1)
Dim rgOK As Range: Set rgOK = lcOK.DataBodyRange
Dim cell As Range, Student, MatchOK, r As Long, IsNotStudentAdded As Boolean
For Each cell In rgStudents.Cells
If rgOK Is Nothing Then
IsNotStudentAdded = True
Else
MatchOK = Application.Match(cell.Value, rgOK, 0)
If IsError(MatchOK) Then IsNotStudentAdded = True
End If
If IsNotStudentAdded Then
Student = cell.Value
For r = 1 To SportsCount
loOK.ListRows.Add.Range.Resize(, 2).Value _
= Array(Student, Sports(r, 1))
Next r
IsNotStudentAdded = False
Set rgOK = lcOK.DataBodyRange
End If
Next cell
MsgBox "Students added.", vbInformation
End Sub
So I decided to completely change my macro to avoid any error :
Sub Macro7()
Dim N, S, i, j
Application.ScreenUpdating = False
N = Range("Tableau1"): S = Sheets("Sports").Range("C3:C5").Value
With Range("Tableau2").ListObject
If .ListRows.Count > 0 Then .DataBodyRange.Delete
For Each i In N
For Each j In S
.ListRows.Add.Range.Resize(, 2) = Array(i, j)
Next
Next
End With
End Sub

Worksheet function Sum-if causing error type mismatch

I am looping through the worksheets to sumif the amounts that are "C" and "D".
Each tabs have the amounts in column M and whether they are credit or debit in column N, indicated by the letter C or D.
First I am putting the letters C and D on blank cells and trying to sumif these two amounts next to them.
I am getting a type mismatch error at the sumif line and the whole line is highlighted.
At first I thought maybe it was ws = Worksheets(I) causing the problem so I swapped them out with Worksheets(I), but it still did not work.
Sub Sumiftabs()
Dim Filepath As String
Dim UIGFile As Workbook
Dim Column As String
Dim Month As String
Dim Year As Integer
Dim I As Long
Dim TY As Integer
Dim TYLetter As String
Dim T As Long
Dim TreatyYear As Long
Dim WS_Count As Integer
Dim ws As Worksheet
Application.ScreenUpdating = False
TreatyYear = Sheets("Control").Range("B7").Value
'On Error Resume Next
For T = TreatyYear To 16 Step -1
TYLetter = WorksheetFunction.VLookup(T, Workbooks("Separate tabs.xlsm").Sheets("Control").Range("H:I"), 2, False)
TY = Sheets("Control").Range("B7").Value
Month = Sheets("Control").Range("B5").Value
Year = Sheets("Control").Range("B4").Value
Filepath = Sheets("Control").Range("B2").Value
Set UIGFile = Workbooks.Open("K:\Ayoon\UIG\" & Year & "\" & Month & "\UIG_NSA_MonYear_TY" & T & ".xls")
WS_Count = UIGFile.Worksheets.Count
For I = WS_Count To 1 Step -1
Set ws = Worksheets(I)
'Direct Premium
UIGFile.Worksheets(I).Range("S4").Value = "C"
UIGFile.Worksheets(I).Range("S5").Value = "D"
UIGFile.Worksheets(I).Range("T4").Value = _
Application.WorksheetFunction.SumIf(ws.Range("N:N"), ws.Range("S:S"), ws.Range("M:M"))
UIGFile.Worksheets(I).Range("T5").Value = _
Application.WorksheetFunction.SumIf(ws.Range("N:N"), ws.Range("S:S"), ws.Range("M:M"))
Next I
UIGFile.Close savechanges:=True
Next T
Application.ScreenUpdating = True
End Sub
Your SUMIF looks incorrect.
Eg try this instead:
UIGFile.Worksheets(I).Range("T4").Value = _
Application.WorksheetFunction.SumIf(ws.Range("N:N"), "C", ws.Range("M:M"))

Why is my VBA SUMIFS function returning zeros?

First, allow me to thank you for any help you are able to lend me. I appreciate it! (:
My issue is this: I have two workbooks, one with raw data, and one in which the raw data is consolidated into relevant statistics. I am trying to SUMIFS the data in X:X in my raw data workbook (6620) by two criteria in the results book and then update the value in the corresponding cell in the results book.
The problem is that the macro returns all zeros. I have double checked the data types, names, ranges, etc, but no luck. Leaving me to think there is something wonky in my code.
I include two photos at the end of this post of example raw data and results tables so you can see what I am working from.
Sub ImportFTEs()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim ws As Integer
Workbooks.Open Filename:=ActiveWorkbook.Path & "\6620\FY19*.xlsb"
For ws = 1 To Worksheets.Count
Sheets(ws).Name = "Sheet1"
Next ws
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim totalFTE As Long
Dim lastRow As Integer
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
Dim wb_a As Worksheet
Set wb_a = Workbooks.Open(ActiveWorkbook.Path & "\FY19*.xlsb").Sheets("Sheet1")
Dim wb_b As Worksheet
Set wb_b = ThisWorkbook.Sheets("B")
Dim sumRange As Range
Set sumRange = wb_a.Range("X:X")
Dim cRange1 As Range
Set cRange1 = wb_a.Range("D:D")
Dim criteria1 As Range
Dim cRange2 As Range
Set cRange2 = wb_a.Range("S:S")
Dim criteria2 As Range
For k = 8 To 18
For l = 7 To 18
For i = 7 To 18
Set criteria1 = wb_b.Cells(7, i)
For j = 8 To 18
Set criteria2 = wb_b.Cells(j, 6)
wb_b.Cells(k, l).value = Application.WorksheetFunction.SumIfs(sumRange, cRange1, criteria1, cRange2, criteria2)
Next j
Next i
Next l
Next k
ActiveWorkbook.Close savechanges:=True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
You don't need so many nested loops. Your original code is looping through every possible criteria for each k and l. Assuming wb_b.Cells(k, l) is supposed to be a reference to the cell intersected by your month column and employee name row, you could use your i and j values.
For i = 7 To 18
Set Criteria1 = wb_b.Cells(7, i)
For j = 8 To 18
Set Criteria2 = wb_b.Cells(j, 6)
wb_b.Cells(j, i).Value = Application.WorksheetFunction.SumIfs(sumRange, cRange1, Criteria1, cRange2, Criteria2)
Next j
Next i

Excel 2013 Overflow due to lack of VBA optimization

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

type mismatch 13 in excel 2010

The following code worked perfectly under excel 2003, but in 2010 returns error 'type mismatch 13' in the following line "If Array2(1, i) <> 0 Then"
Anyone has any ideas how to solve this ?
Thx in advance
Sonny
Her is the code:
Sub BerekenGepresteerdeUrenVoorEenMaand(SheetNaam As String)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Array1 As Variant
Dim Array2 As Variant
Dim Range1 As Range
Dim Range2 As Range
Dim RangeTarget1 As Range
Dim RangeTarget2 As Range
Dim mRange As Excel.Range
Dim RangeNieuwSaldo As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim subTotaal As Double
ActiveWorkbook.Worksheets(SheetNaam).Activate
Set Range1 = ActiveSheet.Range("EersteRij")
Set Range2 = ActiveSheet.Range("LaatsteRij")
Set RangeTarget1 = ActiveSheet.Range("NaamVeld")
Set RangeTarget2 = ActiveSheet.Range("SaldiVeld")
Array1 = Range1.Value
Array2 = Range2.Value
RangeTarget1.Locked = False
RangeTarget2.Locked = False
j = 0
For i = LBound(Array1, 2) To UBound(Array1, 2)
If Array2(1, i) <> 0 Then 'Line generating error
j = j + 1
RangeTarget1.Cells(j, 1).Value = Array1(1, i)
RangeTarget2.Cells(j, 1).Value = Array2(1, i)
Else
End If
Next
For k = j + 1 To 11
RangeTarget1.Cells(k, 1).Value = ""
RangeTarget2.Cells(k, 1).Value = ""
Next
RangeTarget1.Locked = False
RangeTarget2.Locked = False
Erase Array1
Erase Array2
Set Range1 = Nothing
Set Range2 = Nothing
Set RangeTarget1 = Nothing
Set RangeTarget2 = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
i think , at some time , i gets bigger than the input data in array2...
like no data stored in array2(1,10000) or so, and nothing is not a number (like <>0)
so maybe u need a fail-proof condition before your faulty line like:
if not array2(1,i) is nothing then 'or you might just want to exit the For loop here.
if array2(1,i)<>0 then ...
'if this doesn't work try if not IsEmpty(array2(1,i)) as condition
try it, i can't tell more without seing the actual data here...
read more about ubound maybe too, its the upper limit of your array, being data in it or not.
I once thought too that it is the last entry of data in my array, but no, in fact.
dim test(20) as integer
test(1)=23
..
test(10)=44 'last input
a=ubound(test) 'my guess it will return 20, and not 10

Resources