Re: Loop Through Files in Folder and check DateLastModified
It'll work - my method is just me preferring to rely on inbuilt VBA functions rather than an external library. One less layer of complication to break.
Re: Loop Through Files in Folder and check DateLastModified
It'll work - my method is just me preferring to rely on inbuilt VBA functions rather than an external library. One less layer of complication to break.
Re: Loop Through Files in Folder and check DateLastModified
A simple function to loop through the folder using the FileDateTime function along with the DIR function to get a list of all files to make sure everything is dated this month should do it. Pseudo-code (in that it was typed freehand, is untested and may not be syntactically correct) ...
Public Function AllFilesDatedThisMonth(FilePath) as Boolean
Dim fName as String
'// FilePath should NOT have a terminating '/'
fName = DIR(FilePath)
'// If no files found, then exit. The function value will default to 'False'
If fName = vbNullString then Exit Function
Do While fName <> vbNullstring
If Month(FileDateTime(FilePath & "\" & fName)) <> Month(Date) Then
AllFileDatedThisMonth = False
Exit Function
End If
fName = Dir
Loop
'// Gets to here, then all are dated same month.
AllFilesDatedThisMonth = True
Display More
You add a check before the main loop
Re: Excel macro- first sort on col.a,then b,then,c +subtotal of d,e,f based on each
Grief - What's the problem with adding a link?
Unoriginal arguments designed to support your limited and selfish point of view, only. However, the board rules, which you agreed to follow when you joined, require links so there's no poncy arguments about "the positive aspects of cross posting". End of story.
If you cross post and do not add links then there is a chance that anyone replying could be wasting their time if the same, or substantially the same, answer was given on another forum. At least with a link, they can check.
As you have seen fit not to add the link, you can't be too bothered about others possibly wasting their time while trying to help you. If you're not bothered, I (and I would hope, we) are not bothered about helping you. The thread has been closed.
Re: Function VBA Help
The reason you get #value is because the code is throwing an error. I did try to figure out the logic but failed, miserably.
First step: Add error handling to your function.
That, at least, will warn you when things are not right and perhaps you can begin to resolve it from there.
Re: Excel macro- first sort on col.a,then b,then,c +subtotal of d,e,f based on each
[cp]*[/cp]
Please add links to your posts on other forums for this issue - same as you did in your other thread.
Also, attaching a picture is pointless. It just means anyone attempting to help is going to have to recreate your data first - and that takes time. Possibly another reason you are not getting replies. Upload a sample workbook
[sw]*[/sw]
Re: Making the activecell the target of a copy and paste macros
It's a little silly selecting a cell and then checking if the active cell is somewhere else... but maybe you were chopping and changing trying to get it to work.
Try turning the IF statement around the other way:
If Not Intersect(ActiveCell, Range("Paste_Range")) Is Nothing Then
Range("savenam").Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.Offset(0, 2).Select
Else
MsgBox "Please select a correct cell in Columns E, I, M, Q, U, Y or AC.", vbOKOnly, "Warning"
End If
Display More
Re: Create & Save filtered list into new workbook
My apologies - I changed the structure of the code and forgot.
Instead of commenting out the call to the procedure, just comment these lines (in RemoveHiddenRows):
'// Loop through all cells in Col 2. If the row is not visible
'// then add to a range. The entire range is deleted later
' For Each oRow In myRows.Columns(2).Cells
' If oRow.EntireRow.Hidden Then
' If rng Is Nothing Then
' Set rng = oRow
' Else
' Set rng = Union(rng, oRow)
' End If
' End If
' Next
' If Not rng Is Nothing Then rng.EntireRow.Delete
'
' '// And turn off autofiltering
' ws.AutoFilterMode = False
Display More
although it should have been easy enough to follow as comments were included with each block of code that actually did sometihng.
Re: if cell in sheet is empty, cancel SQL and go to next Sub
Have you checked as I mentioned earlier..
Quote from cytop;777644If the code jumps straight to the line you mention then check the actual value of FinalRow. It is probably < 6.
Re: if cell in sheet is empty, cancel SQL and go to next Sub
At that point Branch will ALWAYS be empty...
I've no idea what the procedure Find_Company_Relation_ID does or how it relates to your code, but something like this might work a little better
Sub find_company_Accounts_part2()
Dim uiValue As String
Dim Login As String
Dim LastRow As Long
Dim conn As ADODB.Connection
Dim rec1 As ADODB.Recordset
Dim thisSql As String
Dim branch As String
Dim Acc As String
Dim j As Long
Dim Finalrow As Long
Login = UserForm3.Login.Text
uiValue = UserForm3.uiValue.Text
Finalrow = Sheets("Data").Cells(60000, 5).End(xlUp).Row
'// Create and open the connection first - if not the 'conn.close' later could error
'// if it was never opened.
Set conn = New ADODB.Connection
conn.CommandTimeout = 900
conn.Open "DSN=PROD;Databasename=DB01;Uid=" & Login & ";Pwd=" & uiValue & ";"
For j = 6 To Finalrow
branch = Sheets("Data").Cells(j, 5).Value
Acc = Sheets("Data").Cells(j, 6).Value
If branch = vbNullString Then
'// don;t know what this does. Just going with th elogic you had previously
find_company_relation_ID
Else
'// This is redundant - probably. Already checked
'// If branch <> vbNullString Then
If branch Like "002*" Or branch Like "004*" Then
thisSql = "Select " & _
"ACCOUNT_TYPE_CODE, " & _
"ACCOUNT_OPEN_DATE " & _
"FROM CUST_CUSTACCT_1 " & _
"Where ((BRANCH_NO)= " & branch & ") And ((ACCOUNT_NO)= " & Acc & ") AND EFFECTIVE_END_DT ='9999.12.31'"
Else
thisSql = "Select " & _
"ACCOUNT_TYPE_CODE, " & _
"ACCOUNT_OPEN_DATE " & _
"FROM CUST_CUSTACCT_2 " & _
"Where ((BRANCH_NO)= " & branch & ") And ((ACCOUNT_NO)= " & Acc & ") AND EFFECTIVE_END_DT ='9999.12.31'"
End If
LastRow = Sheets("Results").Cells(60000, 4).End(xlUp).Row + 1
Set rec1 = New ADODB.Recordset
rec1.Open thisSql, conn
'// Make sure there's sometihng to copy.
If Not rec1.EOF Then
Sheets("Results").Cells(LastRow, 4).CopyFromRecordset rec1
End If
rec1.Close
'// End If
Next j
conn.Close
Set conn = Nothing
Set rec1 = Nothing
'find_company_relation_ID
End Sub
Display More
Re: if cell in sheet is empty, cancel SQL and go to next Sub
That code can't run because of mismatched control structures. There's an Extra 'End If' in there. This is probably related to the commented out 'If' block earlier but it is your responsibility to ensure code you post at least compiles so that it can be tested.
If your code refers to controls on a userform or named ranges/worksheets then you should upload a copy of your workbook so that it can be tested without having to go to the extra trouble of recreating your environment first.
If the code jumps straight to the line you mention then check the actual value of FinalRow. It is probably < 6.
Re: MID function error
Please add links to your posts on other forums for this issue - this is something you agreed to do when you joined the forum.
Read this if you want to know why you are asked to do this.
Re: MID function error
[cp]*[/cp]
Re: Programatically activate available control check box in userform additional contr
The users shouldn't have to do it manually as the project will be saved with the correct reference. As it will also be registered on the users machine there is no need for them to have to add the reference to the control. Excel should pick up the correct installation directory from the registry.
Sounds like you are distributing a control with the workbook. Why?
Re: Position code to be extract based on multiple criteria
Got to do the lottery this week. I'm psychic!
Please add links to your posts on other boards for this issue. Do the same for your other thread.
Re: Position code to be extract based on multiple criteria
[cp]*[/cp]
2 threads on this forum, both not in accordance with the forum rules (Also are not in accordance with the rules of the other forum as well). Might suggest you read this and then update your threads on both forums - and please do not simply ignore this request as you have on the other forum.
Re: VBA Excel - Adding a therm on a formula already exist in a cell.
[cp]*[/cp]
Re: VBA Email Format Problem
Add a small function to a standard code module
Public Function AddressBlock(pArray As Variant, Optional strJoin As String = "<br>") As String
Dim iTemp As Integer
Dim strReturn As String
For iTemp = LBound(pArray) To UBound(pArray)
If pArray(iTemp) <> vbNullString Then
strReturn = strReturn & pArray(iTemp) & strJoin
End If
Next
AddressBlock = strReturn
End Function
Display More
Then call it passing all the elements of the address in an array
Re: Copy a template sheet if it doesnt exist from names in a column
"erroring in various places" is not very informative.
Because of the 'Resume Next' statement, the only place it can actually throw an error is
Set myrange = Worksheets("Names").Range("A1")
Set myrange = Range(myrange, myrange.End(xlDown))
Assuming you DO have a worksheet named 'Names' then the error is probably in the 2nd of those lines. A long hand, and not very efficient way, to assign a range like that is to replace both those lines with
'// TYped freehand - Untested
Set myrange = Worksheets("Names").Range(Worksheets("Names").Range("A1"), Worksheets("Names").Range("A" & Rows.Count).End(xlUp))
Every reference to a cell address is qualified with the worksheet name.
Please help others to help you - give full information about an error; where it occurs and any message displayed.