Posts by cytop

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

You add a check before the main loop

If not AllFilesDatedThisMonth() then Exit sub '// (Or whatever)

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

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

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;777644

If 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

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: Copying multiple ranges to a new sheet sequentially

You don't actually extend the second range to cover columns 14-17 - you just mention 14.

Also, you need to explicitly define each 'range'

Union(Range(Cells(i, 2), Cells(i, 12)), Range(Cells(i, 14), Cells(i, 17)))...

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

Then call it passing all the elements of the address in an array

"<b>Address:</b><br>" & _ 'Address in Bold
AddressBlock(Array(txtAdd1.Value, txtAdd2.Value, txtCity.Value, txtCounty.Value))

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.

Re: Unable to run the Private Sub Worksheet_Change(ByVal Target As Range) Macro

A snippet only...

Select Case True 
    Case Not Intersect(Target, Range("C5")) Is Nothing 
        If Range("C5") <> vbNullString then
            '// Code
        End If