I am trying to test on an "IF" statement with 5 criteria, the code works fine if I'm only testing with 3 criteria, but as soon as I add any extra it stops working. No errors, it just stops.
If Me.Count_Criteria_5.Value <> "Any" Then
For i = RowNum To RowNumEnd
If ws.Cells(i, CR1).Value = V_1 And ws.Cells(i, CR2).Value = V_2 And _
ws.Cells(i, CR3).Value = V_3 And ws.Cells(i, CR4).Value = V_4 And _
ws.Cells(i, CR5).Value = V_5 Then
ws.Range("A" & i & ":AM" & i).Copy
ps.Activate
'find first empty row in database
emR = ps.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
ps.Range("A" & emR & ":AM" & emR).PasteSpecial
End If
Next i
Exit Sub
End If ' End 5 Criteria Loop
Am I missing something?
Note: ws and ps are defined as worksheets
UPDATE
Based on the comments on this question, the problem appears to be the criteria being used. It's because of testing against checkboxes. Checkboxes when checked return the value of TRUE. But when testing with this code, it doesn't recognise that the "TRUE" on the worksheet is the same as the "TRUE" in the V_#
Anyone have any ideas?
Use this right before the evaluation.
Msgbox "CR1 = " & ws.Cells(i, CR1) & " V_1 = " & V_1 & vbCrLf & _
"CR2 = " & ws.Cells(i, CR2) & " V_2 = " & V_2 & vbCrLf & _
"CR3 = " & ws.Cells(i, CR3) & " V_3 = " & V_3 & vbCrLf & _
"CR4 = " & ws.Cells(i, CR4) & " V_4 = " & V_4 & vbCrLf & _
"CR5 = " & ws.Cells(i, CR5) & " V_5 = " & V_5 "
to simplify debugging greatly.
EDIT : Try this !
If ws.Cells(i, CR1).Value = V_1 And ws.Cells(i, CR2).Value = V_2 And _
ws.Cells(i, CR3).Value = V_3 And _
(ws.Cells(i, CR4).Value = V_4 or ws.Cells(i, CR4).Value = "TRUE") And _
(ws.Cells(i, CR5).Value = V_5 or ws.Cells(i, CR5).Value = "TRUE") Then
Related
I'm trying to get all possible combinations with a kind of VBA macro presented in https://stackoverflow.com/a/10693789/1992004, but get an error For without Next. I compared the source from another thread with mine, but don't found such difference, which could cause this error.
Do you see, what causes this error? - please point me to. My Code follows.
Option Explicit
Sub Sample()
Dim l As Long, m As Long, n As Long, o As Long, p As Long, q As Long, r As Long, s As Long, t As Long, u As Long
Dim CountComb As Long, lastrow As Long
Range("L2").Value = Now
Application.ScreenUpdating = False
CountComb = 0: lastrow = 18
For l = 1 To 1: For m = 1 To 2
For n = 1 To 2: For o = 1 To 18
For p = 1 To 15: For q = 1 To 10
For r = 1 To 10: For s = 1 To 17
For t = 1 To 3: For u = 1 To 3
Range("L" & lastrow).Value = Range("A" & l).Value & "/" & _
Range("B" & m).Value & "/" & _
Range("C" & n).Value & "/" & _
Range("D" & o).Value & "/" & _
Range("E" & p).Value & "/" & _
Range("F" & q).Value & "/" & _
Range("G" & r).Value & "/" & _
Range("H" & s).Value & "/" & _
Range("I" & t).Value & "/" & _
Range("J" & u).Value
lastrow = lastrow + 1
CountComb = CountComb + 1
Next: Next
Next: Next
Range("L1").Value = CountComb
Range("L3").Value = Now
Application.ScreenUpdating = True
End Sub
All the comments above explain your problem, but this is what your code would look like with proper indenting AND the missing "next" statements:
For l = 1 To 1
For m = 1 To 2
For n = 1 To 2
For o = 1 To 18
For p = 1 To 15
For q = 1 To 10
For r = 1 To 10
For s = 1 To 17
For t = 1 To 3
For u = 1 To 3
Range("L" & lastrow).Value = Range("A" & l).Value & "/" & _
Range("B" & m).Value & "/" & _
Range("C" & n).Value & "/" & _
Range("D" & o).Value & "/" & _
Range("E" & p).Value & "/" & _
Range("F" & q).Value & "/" & _
Range("G" & r).Value & "/" & _
Range("H" & s).Value & "/" & _
Range("I" & t).Value & "/" & _
Range("J" & u).Value
lastrow = lastrow + 1
CountComb = CountComb + 1
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
At the very least, it would have made it immediately obvious where your code was failing.
I'd like to add one more condition to this Loop that would put "Discrepancy" into column J if there is a value in column F that is neither 0 or #VALUE. Any and all suggestions would be appreciated. Thank you, the current code is below:
Sub ERS_Vlookup()
Dim Lastrow As Long
Dim h As Long
For h = 5 To Lastrow
If IsError(ActiveSheet.Range("H" & h).Value) Or
IsError(ActiveSheet.Range("F" & h).Value) Then
ActiveSheet.Range("J" & h).Value = " "
ElseIf ActiveSheet.Range("H" & h).Value <> " " And _
ActiveSheet.Range("F" & h).Value = 0 Then
ActiveSheet.Range("J" & h).Value = "Paid"
Else
ActiveSheet.Range("J" & h).Value = "Processed Not Yet Paid"
End If
Next h
On the face of it, this should work, but I think you need to think it through and check whether these conditions are all mutually exclusive.
Sub ERS_Vlookup()
Dim Lastrow As Long
Dim h As Long
For h = 5 To Lastrow
If IsError(Range("H" & h).Value) Or IsError(Range("F" & h).Value) Then
Range("J" & h).Value = vbNullString
ElseIf Range("H" & h).Value <> vbNullString And Range("F" & h).Value = 0 Then
Range("J" & h).Value = "Paid"
ElseIf Not IsError(Range("F" & h).Value) And Range("F" & h).Value <> 0 Then
Range("J" & h).Value = "Discrepancy"
Else
Range("J" & h).Value = "Processed Not Yet Paid"
End If
Next h
End Sub
You can the use the And function to add booleans to loops
i recomend you visit this website http://www.excel-easy.com/vba/loop.html
for more information
I have some code to pdf and save my file to a folder on my computer. I've tested in the past and had no problem. However, after making some minor changes i am getting run time error 1004. Any ideas on why this is? Very frustrating. Thank you.
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Dim i As Long
Dim ws As Worksheet
Dim FileName As String
Set ws = Sheets("Multi")
Set wsJob = Sheets("Job")
FileName = ws.Range("B2")
LastRow = ws.Range("B" & Rows.Count).End(xlUp).Row
For i = 8 To LastRow
wsJob.Activate
wsJob.Range("AZ1").Value = ws.Range("B" & i)
wsJob.Range("AZ2").Value = ws.Range("C" & i)
wsJob.Range("AZ3").Value = ws.Range("D" & i)
wsJob.Range("AZ4").Value = ws.Range("E" & i)
wsJob.Range("AZ5").Value = ws.Range("F" & i)
wsJob.Range("AZ6").Value = ws.Range("G" & i)
wsJob.ComboBox1.Visible = False
wsJob.ComboBox2.Visible = False
wsJob.ComboBox3.Visible = False
wsJob.ComboBox4.Visible = False
wsJob.ComboBox5.Visible = False
wsJob.ComboBox6.Visible = False
wsJob.CommandButton1.Visible = False
wsJob.Rows("4:13").EntireRow.Hidden = True
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=ws.Range("B2") & "TCC Analysis - " & ws.Range("B" & i) & " - " & ws.Range("C" & i) & " - " & ws.Range("D" & i) & " - " & ws.Range("E" & i) & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
Next i
wsJob.ComboBox1.Visible = True
wsJob.ComboBox2.Visible = True
wsJob.ComboBox3.Visible = True
wsJob.ComboBox4.Visible = True
wsJob.ComboBox5.Visible = True
wsJob.ComboBox6.Visible = True
wsJob.CommandButton1.Visible = True
wsJob.Rows("4:13").EntireRow.Hidden = False
ws.Activate
Application.ScreenUpdating = True
End Sub
Replace this line;
FileName:=ws.Range("B2") & "TCC Analysis - " & ws.Range("B" & i) & " - " & ws.Range("C" & i) & " - " & ws.Range("D" & i) & " - " & ws.Range("E" & i) & ".pdf"
with this;
FileName:=ws.Range("B2").value & "TCC Analysis - " & ws.Range("B" & i).value & " - " & ws.Range("C" & i).value & " - " & ws.Range("D" & i).value & " - " & ws.Range("E" & i).value & ".pdf"
Replace;
wsJob.Range("AZ1").Value = ws.Range("B" & i)
wsJob.Range("AZ2").Value = ws.Range("C" & i)
wsJob.Range("AZ3").Value = ws.Range("D" & i)
wsJob.Range("AZ4").Value = ws.Range("E" & i)
wsJob.Range("AZ5").Value = ws.Range("F" & i)
wsJob.Range("AZ6").Value = ws.Range("G" & i)
with this;
wsJob.Range("AZ1").Value = ws.Range("B" & i).Value
wsJob.Range("AZ2").Value = ws.Range("C" & i).Value
wsJob.Range("AZ3").Value = ws.Range("D" & i).Value
wsJob.Range("AZ4").Value = ws.Range("E" & i).Value
wsJob.Range("AZ5").Value = ws.Range("F" & i).Value
wsJob.Range("AZ6").Value = ws.Range("G" & i).Value
Replace
FileName = Sheets("Multi").Range("B2")
with this
FileName = Sheets("Multi").Range("B2").value
Change FileName decleration with different string because FileName is also using in the ActiveSheet.ExportAsFixedFormat line...
The Description field is a long text field with over 255 characters. so I'm trying to break it down before I update it. My error reads:
Run-Time error '3075 Syntax error (missing Operator) in query
expression "titlename'Set Description = '([prm_val1] &
[prm_val2].....[prm_val7])".
Here's my code:
l = Len(Me.Description)
If l Mod 255 = 0 Then 'For length exactly a multiple of 255 (255, 510, 765...)
n = l / 255
Else
n = Int(l / 255) + 1
End If
sp = "[prm_val1]"
If n > 1 Then 'If >255 chars tap on concatenated parameters as needed
For p = 2 To n
sp = sp & " & [prm_val" & p & "]"
Next p
End If
'UpdateDescription = "UPDATE AllProjects " & _
'"Set Description='" & sp & "'" & _
'" WHERE ID =" & Me.ID
'CurrentDb.Execute UpdateDescription
'For p = 1 To n 'Add each 255 char piece as the parameters
'qdf.Parameters("prm_val" & p) = Mid(varValue, (p - 1) * 255 + 1, 255)
'Next p
'qdf.Execute
DoCmd.SetWarnings False
strSQL = "UPDATE AllProjects " & _
"Set Title='" & Me.Title & "'" & _
"Set Description='(" & sp & ")'" & _
",Department='" & Me.Department & "'" & _
",Priority='" & Me.Priority & "'" & _
",Status='" & Me.Status & "'" & _
",[Create Date]='" & Me.CreateDate & "'" & _
",[% Complete]='" & Me.PerComplete & "'" & _
",[File Location]='" & Me.FileLocation & "'" & _
",[Update Notes]='" & Me.UpdateNotes & "'" & _
",Leader='" & Me.Leader & "'" & _
",[Target Date]='" & Me.TargetDate & "'" & _
",[Complete Date]='" & Me.CompleteDate & "'" & _
",Category='" & Me.Category & "'" & _
",Feedback='" & Me.Feedback & "'" & _
",[File Location 2]='" & Me.FileLocation2 & "'" & _
",[File Location 3]='" & Me.FileLocation3 & "'" & _
",[Strategic Initiatives]='" & Me.StrategicInitiatives & "'" & _
" WHERE ID =" & Me.ID
CurrentDb.Execute strSQL
For p = 1 To n 'Add each 255 char piece as the parameters
strSQL.Parameters("prm_val" & p) = Mid(varValue, (p - 1) * 255 + 1, 255)
Next p
DoCmd.SetWarnings True
This code is called after the execute, and does not make any sense:
For p = 1 To n 'Add each 255 char piece as the parameters
strSQL.Parameters("prm_val" & p) = Mid(varValue, (p - 1) * 255 + 1, 255)
Next p
as strSQL doesn't take parameters.
Adjust this code and move it inte the code before calling execute.
Or use the query you have commented out.
The code below calculate an average between col E, colG and col I (like in the picture in column K)but something doesn't work how I need. My code doesn't take correctly column G. It takes in the loop 5,7,3,15,10 and not 5,5,7,3,3,3,15,15,10,10. It doesn't consider how many repetitive names are in column A. How to solve the problem? Anyone is able to help? thanks!
(look at the picture)
For f= 1 To ws.Range("F" & Rows.Count).End(xlUp).Row
nameF = ws.Range("F" & f).Value
For totRng = 1 To lastrowA
'if names from col A and col F coincide, then sum their numbers from col E
If nameF = ws.Range("A" & totRng).Value Then ws.Range("G" & f).Value =
ws.Range("G" & f).Value + ws.Range("E" & totRng).Value
On Error Resume Next
If nameF = ws.Range("A" & totRng).Value Then _
ws.Range("H" & f).Value = ((ws.Range("E" & f).Value / ws.Range("G" & f).Value)) * ws.Range("I" & f).Value
Next totRng
Next f
I should change this value: '/ ws.Range("G" & f).Value)'
Here a working piece of code
For f = 2 To ws.Range("F" & Rows.Count).End(xlUp).Row
nameF = ws.Range("F" & f).Value
For totRng = 2 To lastrowA
'if names from col A and col F coincide, then sum their numbers from col E
If nameF = ws.Range("A" & totRng).Value Then
ws.Range("G" & f).Value = ws.Range("G" & f).Value + ws.Range("E" & totRng).Value
End If
Next totRng
For totRng = 2 To lastrowA
'calculate the average
If nameF = ws.Range("A" & totRng).Value Then
Debug.Print nameF & " found on line " & totRng & " person we have is on line " & f & ". Formula is : ((" & ws.Range("E" & totRng).Value & "/" & ws.Range("G" & f).Value & ")*" & ws.Range("I" & totRng).Value & "=" & (((ws.Range("E" & totRng).Value / ws.Range("G" & f).Value)) * ws.Range("I" & totRng).Value)
ws.Range("H" & f).Value = ws.Range("H" & f).Value + (((ws.Range("E" & totRng).Value / ws.Range("G" & f).Value)) * ws.Range("I" & totRng).Value)
End If
Next totRng
Next f