Updated:
Taking into consideration community comments, I have made some changes (declarations, removed unnecessary variables) and attempted two styles to no avail.
Without criteria the code returns 400, after one line is populated.
.Cells(i, 38 + l) = Evaluate("=SUMPRODUCT(" & Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn & "," & Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn & ",--(" & Worksheets(Cells(i, 1).Value).Columns(4).EntireColumn & "=" & .Cells(i, 2).Value & "),--(" & Worksheets(Cells(i, 1).Value).Columns(5).EntireColumn & "=" & .Cells(i, 3).Value & "))")
And also:
.Cells(i, 38 + l) = Application.WorksheetFunction.SumProduct(Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn, Worksheets(Cells(i, 1).Value).Columns(83 + l * 4).EntireColumn, --(Worksheets(Cells(i, 1).Value).Columns(4).EntireColumn = .Cells(i, 2).Value), --(Worksheets(Cells(i, 1).Value).Columns(5).EntireColumn = .Cells(i, 3).Value))
/Update end.
I have been trying to code a macro, which will gather data from different worksheets of one workbook to summary sheet and perform necessary calculations ("sumifs", "sumproduct") in cycle. The same code will be used in the other workbooks with different variable parameters.
While "sumifs" is working fine, there is an issue with "sumproduct" function (I am using Application.WorksheetFunction instead of Evaluate).
The code returns Type Mismatch error. Most likely I am calling the function improperly, OR, the criteria within the function.
I am kindly asking for community support, as I feel, I have exhausted my ability to think today.
' Populate table from KA sheets for I/O to SOP Report
Dim EndRow As Long
Dim i As Long
Dim j As Long
Dim l As Long
Dim catLst As Range
Dim pglst As Range
Start:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
EndRow = Cells(Rows.Count, 1).End(xlUp).Row
Set pglst = ThisWorkbook.Worksheets("SUMMARY").Range("$D:$D")
Set catLst = ThisWorkbook.Worksheets("SUMMARY").Range("$E:$E")
For i = 4 To EndRow
For j = 0 To 24
For l = 0 To 6
With ThisWorkbook.Worksheets("IO")
.Cells(i, 4 + j) = Application.WorksheetFunction.SumIfs(Worksheets(Cells(i, 1).Value).Columns(54 + j).EntireColumn, pglst, .Cells(i, 2).Value, catLst, .Cells(i, 3).Value)
.Cells(i, 30 + l) = Application.WorksheetFunction.SumIfs(Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn, pglst, .Cells(i, 2).Value, catLst, .Cells(i, 3).Value)
.Cells(i, 38 + l) = Application.WorksheetFunction.SumProduct(Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn, Worksheets(Cells(i, 1).Value).Columns(83 + l * 4).EntireColumn, --(Worksheets(Cells(i, 1).Value).Columns(4).EntireColumn = .Cells(i, 2).Value), --(Worksheets(Cells(i, 1).Value).Columns(5).EntireColumn = .Cells(i, 3).Value))
' .Cells(i, 38 + l) = Evaluate("=SUMPRODUCT(" & Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn & "," & Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn & ",--(" & Worksheets(Cells(i, 1).Value).Columns(4).EntireColumn & "=" & .Cells(i, 2).Value & "),--(" & Worksheets(Cells(i, 1).Value).Columns(5).EntireColumn & "=" & .Cells(i, 3).Value & "))")
End With
Next l
Next j
Next i
'Set i = Nothing
'Set j = Nothing
'Set l = Nothing
ThisWorkbook.Worksheets("IO").Range("AS1") = "UPDATED: " & Format(Now(), "dd/mm/yyyy HH:MM")
Finish:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
First thing:
Dim catLst, pglst, condPG, condCAT As Range
only condCAT is declared as Range the rest is declared as Variant.
(Same with your long declaration)
Like BigBen wrote, it is unclear what you are doing with this evaluate.
You should not use Evaluate
Set for every part in your SumProduct a range. So that your Sumproduct would be like
Application.WorksheetFunction.SumProduct(range1,range2,...)
And look, if every range has the same size. SumProduct is a matrix function.
E.G. Range("A1:A5") Range("B1:B3") could not work in Sumproduct because of Elements
But I guess, some parts of your SumProduct are just wrong type.
I'm trying to simplify my code to dynamically check some values and update a bunch of tickboxes.
The tickboxes are sort of a table, their name is "col" & number_of_column & type_of_data
ie:
Col1PAM Col2PAM Col3PAM
Col1RL Col2RL Col3RL
I tried a simple approach with for...next which works:`
For i = 1 To 16
If ThisWorkbook.Sheets("Setup").Cells(j + 2, i + 1) = 1 Then
Me.Controls("Col" & i & "PAM").Value = True
Else: Me.Controls("Col" & i & "PAM").Value = False
End If
If ThisWorkbook.Sheets("Setup").Cells(j + 3, i + 1) = 1 Then
Me.Controls("Col" & i & "RL").Value = True
Else: Me.Controls("Col" & i & "RL").Value = False
End If
Next i
But I have a lot of column types and I tried to make the column type dynamic:
Dim Coltype1 As String
Dim coltype2 As String
Coltype1 = "PAM"
coltype2 = "RL"
For j = 1 To 2
For i = 1 To 16
If ThisWorkbook.Sheets("Setup").Cells(j + 2, i + 1) = 1 Then
Me.Controls("Col" & i & ("Coltype" & j)).Value = True
Else: Me.Controls("Col" & i & ("Coltype" & j)).Value = False
End If
Next i
Next j
My syntax is incorrect and after many tries, I can't figure out what would be a proper one. Any advice ?
On a side note, I also tried the for...next approach to declare my coltype1, coltype2... variables but it looks like you can't do that?
Thanks for any tips!
Something like this:
Dim arr(1 To 2) As String, ws As WorkSheet, i As Long, j As Long
Set ws = ThisWorkbook.Sheets("Setup")
arr(1) = "PAM"
arr(2) = "RL"
For j = 1 To 2
For i = 1 To 16
Me.Controls("Col" & i & arr(j)).Value = (ws.Cells(j + 2, i + 1) = 1)
Next i
Next j
I tried several ways, but I still have a problem in my code.
What I want to do (this example in Q2 on Sheet4):
=INDEX('Sheet8'!K:K,MATCH('Sheet4'!P2,'Sheet8'!A:A,0))
I'd like to do it for all rows with content in column K on Sheet 4 so I'll probably need "For i = 1..."
What I tried:
For i = 1 To LastRowShort
row_mtch = Application.WorksheetFunction.Match(Sheet4.Cells("Q????").Value, Sheet8.Range("A1:A"), 0)
Sheet4.Range("R" & i).Value = Application.WorksheetFunction.Index(Sheet8.Range("K1:K" & LastRowShort), row_mtch)
Next i
Thanks a lot!
Andy
Entire Module:
Sub MissingBoth()
Application.ScreenUpdating = False
Dim MyRange, CopyRange As Range
Dim LastRow As Long
Dim LastRowSheet4 As Long
Dim LastRowSheet8 As Long
Set src4 = Sheet2
Set dst4 = Sheet4
LastRow = src4.Cells(Cells.Rows.Count, "D").End(xlUp).Row
LastRowSheet8 = Worksheets("Sheet8").Cells(Cells.Rows.Count, "B").End(xlUp).Row
LastRowSheet4 = Worksheets("Sheet4").Cells(Cells.Rows.Count, "K").End(xlUp).Row
src4.Unprotect
dst4.Unprotect
If src4.FilterMode = True Then
src4.ShowAllData
End If
dst4.Cells.ClearFormats
dst4.Cells.Clear
'Find content in the "Type of Rack" cells
j = 3
For i = 10 To LastRow
If src4.Cells(i, "CL").Value = "" And src4.Cells(i, "GV").Value = "" Then
src4.Cells(i, "CL").EntireRow.Copy dst4.Cells(j, 1)
j = j + 1
End If
Next i
src4.Range("A6:GW7").Copy Destination:=dst4.Range("A1:GW2")
'Copy every column EXCEPT the following
dst4.Range("GW1,CM1:GU1, U1:CK1,R1:S1,P1,J1:M1").EntireColumn.Delete
For i = 1 To LastRowSheet4
For i2 = 1 To LastRowSheet8
If Worksheets("Sheet4").Range("P" & i).Value = Worksheets("Sheet8").Range("A" & i2).Value Then
Worksheets("Sheet4").Range("Q" & i).Value = Worksheets("Sheet8").Range("K" & i2).Value
End If
Next i2
Next i
dst4.Columns("A:AX").EntireColumn.AutoFit
dst4.Rows("1:500").RowHeight = 15
dst4.Columns("N:O").Interior.Color = vbYellow
dst4.Rows("1:2").Interior.ColorIndex = 15
dst4.Range("B:I").EntireColumn.Hidden = True
Application.ScreenUpdating = True
End Sub
Have you tried something like the following code:
For i = 1 To LastRowSheet4
For i2 = 1 To LastRowSheet8
If Worksheets("Sheet4").Range("P" & i).Value = Worksheets("Sheet8").Range("A" & i2).Value Then
Worksheets("Sheet4").Range("Q" & i).Value = Worksheets("Sheet8").Range("K" & i2).Value
End If
Next i2
Next i
You will just need to define the upper ends of both sheets (LastRowSheet4 and LastRowSheet8) and this should work.
Thanks for your help. I solved the problem with recording a macro and modifying it:
Sheet4.Cells(3, 17).FormulaR1C1 = _
"=INDEX('TS-48 Matrix'!C[-7],MATCH('Missing Both'!RC[-1],'TS-48 Matrix'!C[-16],0))"
Range("Q3").AutoFill Destination:=Range("Q3:Q" & lastRowSheet4)
I have a simple explanation of what I'm having trouble with.
Column A: List of 100 names (each Name exists 2 times)
Column B: Email Address associated with the names(each Name has emailadress)
Example:
A1: James B1:oldmail#hotmail.com
A10: James B10:newmail#hotmail.com
So I want to get this===>>
A1:James B1:newmail#hotmail.com
Basically i want to use vlookup or adressmatch to update the email adress, when two values in Column A match.
How can i do this?
Try with below code
Note: it will work if the column A each name have two times only
If the Column A names appear one time it will considered as the new one in B column.
Sub test()
Dim lastrow As Long
Dim incre As Long
Dim flag As String
flag = "no"
lastrow = Range("A" & Rows.Count).End(xlUp).Row
incre = 1
ReDim names(lastrow, 2) As String
For i = 1 To lastrow
names(i, 1) = Range("A" & i).Value
names(i, 2) = Range("B" & i).Value
Next i
For i = 1 To lastrow
For j = i + 1 To lastrow
If names(i, 1) = names(j, 1) Then
flag = "yes"
Range("C" & incre) = names(j, 1) & " Value: " & names(j, 2)
incre = incre + 1
End If
Next j
If flag = "no" Then
Range("C" & incre) = names(i, 1) & " Value: " & names(i, 2)
Else
flag = "no"
End If
Next i
End Sub
I am trying to export data from a excel to word but something goes wrong at the begging of the while statement. For some reason I get an error at the line ReDim Preserve zPList(zIndex) As personClass, the error is Subscript out of range.
Can someone help please?
Public Sub GetExcelData(ByRef zPList() As personClass, ByRef zIndex As Integer)
Dim tempStr As String
tempStr = ""
Dim row As Integer
row = 2
While tempStr <> "zzz"
zindez = zIndex + 1
ReDim Preserve zPList(zIndex) As personClass
Set zPList(zIndex) = New personClass
Range("A" + CStr(row)).Select
zPList(zIndex).fname = ActiveCell.text
Range("B" + CStr(row)).Select
zPList(zIndex).lname = ActiveCell.text
Range("C" + CStr(row)).Select
zPList(zIndex).Email = ActiveCell.text
Range("D" + CStr(row)).Select
zPList(zIndex).phoneN = ActiveCell.text
row = row + 1
Range("A" + CStr(row)).Select
tempStr = ActiveCell.text
Wend
End Sub