Posts by BCP

Re: Call Form from Excel worksheet button

Thanks Cytop! That worked.

I had been testing "Frm_Employees.Show", not realizing I needed to drop the "Frm_". It also was very useful to place the Show command within its own sub. so I could choose it from the button's macro list.

Brian

I am accustomed to calling subs from buttons on an Excel Worksheet. Now I have a form with a combo box and it doesn't appear possible to assign the Form's Initialize sub to a worksheet button, because the sub isn't visible in the list of available macros for the button. I don't want the form to appear automatically when the worksheet is open. I want the form to appear when the user selects a particular button. How can that be done? What am I missing?

Please advise.

Thanks,

Brian

Re: Dir function

Quote from cytop;670674

Comment out the

Code

On Error Resume Next

and see what happens when it runs...

Thanks for your help and suggestions cytop.

I fixed the script by installing a file open counter and a related patch to "refresh" the Excel VBA Dir () function. Otherwise, it returned a null string, i.e. "". Other changes I made first that didn't solve the problem included changing the Sub to a Public Sub and I dimmed StrFile at the local level (within the only sub it is used in).

Public Sub PyramidFiles()
    
    Dim StrFile As String
    Dim StrDirectory As String
    StrDirectory = "C:\Pyramid Files"
    StrFile = Dir("C:\Pyramid Files\HPES_Asset_Recon*")
          
    Dim sh As Worksheet, flg As Boolean
          
    Do While StrFile <> ""
       For Each sh In Worksheets
           If sh.Name = "Pyramid File" Then flg = True: Exit For
       Next
       
       If flg = True Then
              Application.DisplayAlerts = False
              WSB.Delete
              Application.DisplayAlerts = True
              Filename = StrDirectory + "\" + StrFile
              opencount = opencount + 1
              OpenPyramidFiles
       
       Else:  Filename = StrDirectory + "\" + StrFile
              opencount = opencount + 1
              OpenPyramidFiles
       End If
       
       'This is a patch to refresh/enable Dir iterations.  Otherwise, StrFile evaluates to "".
      
        StrFile = Dir("C:\Pyramid Files\HPES_Asset_Recon*")
       
        For Z = 1 To opencount
             StrFile = Dir()
       Next Z
   
Loop


End Sub

Re: Dir function

Quote from cytop;670659

How about mentioning the actual Error number/message...?

There isn't an error message. It doesn't execute the line, then the "yellow highlight" goes to the previous sub and quits. I have seen that kind of behavior before when the VB Editor can't evaluate something.

Hi,

When I step-through my code below, it always opens the first file in the directory "C:\Pyramid Files", but when it comes back to the Pyramid Files sub after fully processing the first file via various other subs, the VB Editor apparently doesn't like something about this line: StrFile = Dir(), since it quits after "snapping-back" to the previous sub Initialize(). I have also tried StrFile = Dir, but that doesn't work either. I did Dim Strfile in the General Declarations. When I set Watches for Dir and Dir(), I get the value "Invalid procedure call or argument" for both, as if the directory function lost the value. I can't determine why this is happening. Can you see what I am missing?

Dim WSM As Worksheet, WSB As Worksheet, WS1 As Worksheet, [U]StrFile As String[/U], StrDirectory As String, ClientCode As String
Dim Filename As String, LastRowb As Long, LastColB As Integer, LastRow1 As Integer, NextRowC As Integer, x As Integer, y As Integer


Public Sub Initialize()
  Set WSM = ThisWorkbook.Worksheets("Macro")
  Set WS1 = ThisWorkbook.Worksheets("Sheet1")
   
'Create a directory to store individual client files
On Error Resume Next
MkDir "c:\Client Code Files"
Application.ScreenUpdating = False


PyramidFiles
Application.ScreenUpdating = True
End Sub


Sub PyramidFiles()
    
    StrDirectory = "C:\Pyramid Files"
    StrFile = Dir("C:\Pyramid Files\HPES_Asset_Recon*")
          
    Dim sh As Worksheet, flg As Boolean
          
    Do While StrFile <> ""
       For Each sh In Worksheets
           If sh.Name = "Pyramid File" Then flg = True: Exit For
       Next
       
       If flg = True Then
              WSB.Delete
              Filename = StrDirectory + "\" + StrFile
              OpenPyramidFiles
       
       Else:  Filename = StrDirectory + "\" + StrFile
              OpenPyramidFiles
       End If
      
       StrFile = Dir()    'Note: The script had a problem with this line.  It "snapped-back" to the Initialize sub and quit.
       
     Loop


End Sub

Hello,

I'm getting a Subcript Out of Range error for an array based on an Excel spreadsheet, and I can see that it is because there is a blank in the cell that the array is attempting to retrieve the element from. I have been trying to get past that error with no success.

For Example:

If cwlaArray(r, 3) = "" Then]

returns "Subscript Out of Range" rather than True. I can't use an "On Error Resume Next" since I don't want the next lines of script executed.

Here is the part of my script where the problem occurs. The bolded line is where the error occurs. I would like it to exit the If and For statements.

For r = 2 To UBound(cwlaArray, 1)
    'Test whether the Customer Code in the CWLA File equals that in the Pyramid file
    [B]If cwlaArray(r, 3) = PyrCC[/B] Then
       ClientCode = cwlaArray(r, 1)
       PyrRow = ecell.Row
       Fname2 = "c:\Client Code Files\" & ClientCode & ".xlsx"
       WriteRowtoClientFile
       Exit For
    End If
Next r

Any help is much appreciated.

Brian

Hello, I keep stepping-through my code and can't find the answer to the above error message. It runs fine until it get to the line with the Vlookup. Can you see the problem I can't see?

Public Sub VBAVlookup()
Set WSB = ThisWorkbook.Worksheets("Federal ITR")
LastRowB = Cells(Rows.Count, 2).End(xlUp).Row
Set WSI = ThisWorkbook.Worksheets("PrevFedITR")
LastRowI = Cells(Rows.Count, 2).End(xlUp).Row
 'Step 1.2.254 of SOP
 'Filter Current Fed ITR column O - "Trans./event type" - for "2"
 WSB.Range("O1").AutoFilter Field:=15, Criteria1:="2"
 'Variable to store the 1st visible row below the header of the filtered range
 VRow = WSB.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row
 'Formula Input Range
 Dim Frange As Range
 Set Frange = WSB.Range(Cells(VRow, 46).Address, Cells(LastRowB, 46).Address)
  
 '1st Lookup Reference Cell
 'Dim Lref As Range
 Lref = "AX" & VRow
  
 'Lookup Range
 Dim Lrange As Range
 Set Lrange = WSI.Range(Cells(2, 46).Address, Cells(LastRowI, 47).Address)
  
 'For Next Statement incorporating Vlookup
 For Each c In Frange
  
 'On Error Resume Next
  
 c.Value = Application.WorksheetFunction.VLookup(Lref, Lrange, 2, False)
   
 VRow = VRow + 1
 Lref = "AX" & VRow
  
  Next c
   
WSB.Columns("AT").NumberFormat = "mm/dd/yyyy"
WSB.Columns("AT").EntireColumn.AutoFit
End Sub

Hi,

Using Excel VBA code, I am building a 67,500 row spreadsheet that is growing constantly larger as I add columns to the right. I often open a workbook, copy a spreadsheet of interest into my dedicated macro workbook, close the non-macro workbook, and process information from the added spreadsheet. After processing the information from the added spreadsheet, I delete it.

As I build, many columns are inserted, V-lookups are added, and formulas are converted to values. There is no problem, until I get to a certain point where the conversion of formulas to values slows down to a crawl - and that is a generous description! The worksheet slows down dramatically when I attempt to convert 2 consecutive columns from formulas to values. At that point, the spreadsheet has 37 columns and 67,500 rows. I have all of my code in 1 module with 25 subroutines. Should I break the code into a 2nd module, or is there some other problem you see or approach you can suggest?

Thanks for any suggestions!

Brian

Re: Excel VBA replace function using not equal to or not. Is it possible?

Quote from JasperD;650785

what do you mean with "not X" - what are you trying to do specifically?

Hi Jasper,

I mean that out of a column list of say 10 values, I only want to retain 1 X value in that column, so I want to essentially say "replace not X with a blank".

Brian

I would like to use range.replace, but for the What: I need to use "Not X" but it doesn't work. How else can I state that or won't that work at all?

Thanks.

Brian

Re: Multiply each value in a column by 1

I found an approach on ozgrid at www.ozgrid.com/forum/showthread.php?t=31644
that I recorded and modified to suit. The code worked for me, and finally, my V-Lookups work! I needed to modify a column that had numbers, text and mixed text and numbers to numbers - at least where there were numbers - so the multiplication by 1 gave me true numbers in that column that I needed to be referenced by the V-Lookups:

Range("BG1").Value = 1
Range("BG1").Copy


PODtlRpt.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

Note that range BG1 is a few columns to the right of my last data column.

Re: Multiply each value in a column by 1

Thanks Gary's Student. I may have to go with the cells method, but I was hoping there would be a quicker way than looping through cells.

Here is the code I wrote to multiply a column of values by 1:

Dim PODtlRpt As Range
   Set PODtlRpt = WSF.Range(Cells(2, 9).Address, Cells(LastRowF, 9).Address)PODtlRpt.Value = PODtlRpt.Value * 1

I am getting a Type Mismatch Error. Any idea why and how to restate it?

Thanks,

Brian

Re: Problem with Loading Array with Cell Values: "Type Mismatch Error"

Thanks Stephen R!

I tried these experimental changes and was able to resolve
the problem(s) with your help:

Dim Name1(20), Name2(20) As String

Brian

Hello,

I know what Type Mismatch means, but I haven't been able to figure out the cause of the Type Mismatch error I am getting for this line of code:
Name1(s) = CurCell.Offset(s, 2)

In the Immediate Window, I get a Vendor Name for CurCell.Offset(s,2) and I Dimmed Name1 As Variant (for an Array), so that seems to be sufficient to me, but I nevertheless get the "Type Mismatch" error. Can you point me in the right
direction?

Public Sub Analyze()


Dim WSA As Worksheet: Set WSA = Worksheets("Sheet1")
Dim s As Integer, Z As Integer, CurCell As Variant, Name1 As Variant, Name2 As Variant, Address As Variant
Dim City As Variant, State As Variant, Zip As Variant, Box7AMt As Variant, Submittor As Variant


LastRowA = Cells(Rows.Count, 1).End(xlUp).Row
    
    For Counter = 2 To LastRowA
        Set CurCell = WSA.Cells(Counter, 3)
        
        If CurCell.Offset(1, 0) <> CurCell Then
           'curCell row should remain as it is
        ElseIf CurCell = CurCell.Offset(1, 0) Then
               Z = 1
            Do Until CurCell <> CurCell.Offset(Z, 0)
               Z = Z + 1
            Loop
            For s = 0 To Z - 1
                Name1(s) = CurCell.Offset(s, 2)
                Name2(s) = CurCell.Offset(s, 3)
                Address(s) = CurCell.Offset(s, 4)
                City(s) = CurCell.Offset(s, 5)
                State(s) = CurCell.Offset(s, 6)
                Zip(s) = CurCell.Offset(s, 7)
                Box7AMt(s) = CurCell.Offset(s, 16)
                Submittor(s) = CurCell.Offset(s, 17)
            Next s
                
        End If
    
    Next Counter


End Sub

Re: Find is returning a string value rather than a range

Thanks Stephen R!

Given your input, I was able to get to the information I was seeking using the following code:

Public Sub NewLocAddr(LocUnique)
Dim aCell As Range
Dim aCelladdr As String
Dim LocNewAddr(20) As String
x = 0
Do
Set aCell = Columns(9).Find(LocUnique)
    
    'If Not aCell Is Nothing Then
     
     If aCell <> "" Then
       y = y + 1
       aCelladdr = aCell.Address
       LocNewAddr(y) = Range(aCelladdr).Offset(0, 1)
       x = x + 1
    End If
Loop Until x = 1
End Sub

...but I still have to heed your advice to test whether the Find return value is nothing, since that happened with y=2. I commented-out your suggested revision and will work with that next. Thanks again.

Brian

Here is my subroutine that is returning a string value instead of a range:

Public Sub NewLocAddr(LocUnique)
Dim aCell As Range
Dim LocNewAddr As Variant
Do
Set aCell = Columns(9).Find(LocUnique)
    If aCell <> "" Then
       y = y + 1
       LocNewAddr(y) = aCell.Offset(0, 1)
       x=x+1     
   End If
Loop Until x = 1
x = 0
End Sub

When I hover my cursor over the "aCell" in the Find statement when I step-through the code, I see a string that contains an alphanumeric location string rather than a range.

I was under the impression that ".Find" always returns a range, but in this case
it doesn't. Does anyone know why or how a value rather than a range is being returned?

Thanks,

Brian

Re: 2010 Outlook VBA - Accessing non-default folders

Thank you Greg! That appears to work, subject to testing by my internal customer, but I am confident she will have success also.

I have searched for that answer on the web from many different perspectives, but never hit on an answer that was that closely related to my question.

Brian

I have viewed many threads on this topic, but I just can't get this to
work for me: Please note that the folder "USPS Compass JE" is on the same
folder hierarchy level as Inbox.

Dim olapp As Outlook.Application
Dim olNameSpace As Outlook.Namespace
Dim olfolder As Outlook.MAPIFolder


Set olapp = CreateObject("Outlook.Application")
Set olNameSpace = olapp.GetNamespace("MAPI")
Set olfolder = olNameSpace.Folders("USPS Compass JE")

When I look at the folder's properties, it's location is:
\\Mailbox - Pelkey, Brian

When I step through the code, I get an error message for the last
coded line that "An object cannot be found".

I also have tried:

Set olfolder = olNameSpace.Folders("Mailbox - Pelkey,Brian/USPS Compass JE")

AND also the GETFOLDER method which didn't appear to be valid.

Thanks for any informed help offered.

Brian