Posts by dsmith616

dsmith616 · Nov 11th 2016

Re: Displaying File 'Comments' in (Properties > Details) with Excel VBA

I hope this isn't too old of a thread. I'm trying to use the code in the forum but none of it is working and I'm not quite understanding the link posted by snb.

I'm attempting to get the Extended Properties as well but nothing I try works even though the code here was verified as working.

Code

Sub FileDetails()   




'Pulls in name for each file in specified folder location




Dim ctr As Integer
Dim path As Variant
Dim file As Variant




ctr = 1
'path = "J:\DefaultManagement\Timeline Management\Foreclosure Bid Approval\JFIGS\ "   ' Path should always contain a '\' at end
path = "P:\Rejected\"
file = Dir(path)    ' Retrieving the first entry.
Do Until file = ""   ' Start the loop.
  Worksheets("Folder").Cells(ctr + 1, 1).Value = file
  
  ctr = ctr + 1
  file = Dir()   ' Getting next entry.
Loop








End Sub

Display More

dsmith616 · Aug 18th 2016

Re: Copy row to new sheet based on cell value

Sorry for the delayed response I was traveling out of town. I've included a sample that hopefully makes sense.

On tab "CIT291", Column A, is a status column of the agents work. What I'd like to do is when the agent selects "Done" from either a drop down or manually types it (not sure if the coding will vary depending on method - either way is fine; easier route is acceptable) it'll copy that row over to the tab "CIT291_History". All other line items may stay on the original tab.

dsmith616 · Jul 29th 2016

Is it possible that to use a keyword, "Done" for example, to then allow a button macro copy and paste that record to an existing tab?

dsmith616 · Jun 24th 2016

Re: Extract multiple numeric value sets

HOLY COW! Not only was that possibly the quickest reply I've seen it does work 100%!!!

Quote from skywriter;773008

You can try this. :cool:

Code

Function GetNineNumbers(cell As Range)
Dim tStr As String
Dim regex As Object
Dim m As Object, j As Object
If cell.Cells.Count > 1 Then
    GetNineNumbers = "Pick only 1 cell."
    Exit Function
End If
Set regex = CreateObject("VBScript.RegExp")
With regex
    .Pattern = "\b\d{9}\b"
    .Global = True
    If .test(cell) Then
        Set m = .Execute(cell)
            For Each j In m
                tStr = Trim(tStr) & " " & j & ","
            Next j
        tStr = Left(tStr, (Len(tStr) - 1))
    Else
        GetNineNumbers = "No matches."
        Exit Function
    End If
End With
    GetNineNumbers = tStr
End Function

Display More

dsmith616 · Jun 23rd 2016

I found an extremely useful VBA code for extracting numeric values from a cell IF and ONLY IF there is only one set of numbers looking to be extracted. However, in my case there are times where I need to extract multiple numeric values, but I'm not sure how to tweak the current code. Any thoughts?

Below is an example of what my worst case scenario would look like. At the end of the day all I need are the 9 digit numeric value after the "RID". However, one problem is "RID" is not always present in these comments in addition if possible I'd like to exclude dates. Not sure if this is plausible or not, but thought I'd ask anyways.

[TABLE="width: 813"]

[tr]

[TD="class: xl64, align: left"]RID: 576233191; RID: 576372763;RID: 576372769;RID: 576372770;RID: 576372774;RID: 576372776;RID: 576372779;RID: 576372782; Please have this process shut down as it is a duplicate. The sale date has been changed from 6/23/16 to 8/4/16. This change occurred because an IRS lien was discovered and proper notices needed to be sent in order to be in compliance with the judgment order. Please have all rails/processes that were auto launched off the 6/23/16 sale date removed/closed. The NTRID are mentioned above. Thank you[/TD]

[/tr]

[/TABLE]

Code

Option Explicit


Function ExtractNumber(rCell As Range, _
     Optional Take_decimal As Boolean, Optional Take_negative As Boolean) As Double




    




Dim iCount As Integer, i As Integer, iLoop As Integer
    Dim sText As String, strNeg As String, strDec As String
    Dim lNum As String
    Dim vVal, vVal2




     ''''''''''''''''''''''''''''''''''''''''''
     'Written by OzGrid Business Applications
     'www.ozgrid.com
     'Extracts a number from a cell containing text and numbers.




     ''''''''''''''''''''''''''''''''''''''''''




    sText = rCell
    
    If Take_decimal = True And Take_negative = True Then
        strNeg = "-" 'Negative Sign MUST be before 1st number.
        strDec = "."
    ElseIf Take_decimal = True And Take_negative = False Then
        strNeg = vbNullString
        strDec = "."
    ElseIf Take_decimal = False And Take_negative = True Then
        strNeg = "-"
        strDec = vbNullString
    End If




    iLoop = Len(sText)




            For iCount = iLoop To 1 Step -1
            vVal = Mid(sText, iCount, 1)
                If IsNumeric(vVal) Or vVal = strNeg Or vVal = strDec Then
                    i = i + 1
                    lNum = Mid(sText, iCount, 1) & lNum
                        If IsNumeric(lNum) Then
                            If CDbl(lNum) < 0 Then Exit For
                        Else
                          lNum = Replace(lNum, Left(lNum, 1), "", , 1)
                        End If
                End If
                If i = 1 And lNum <> vbNullString Then lNum = CDbl(Mid(lNum, 1, 1))
            Next iCount
    ExtractNumber = CDbl(lNum)
     




End Function

Display More

dsmith616 · Jun 16th 2016

Re: Call Function only working when Step Thru

Quote from rory;772609

Typically, this means that your connections are set to refresh in the background. What that means is that your code continues running before the tables are refreshed, and therefore there isn't any data for it to process. You need to turn off the background querying.

Thanks for the tip rory. Originally I tried using 'DoEvents' which didn't work then I tried adding a delay and failed as well. However, based on your response I did a little more research and found a new option called "Application.CalculateUntilAsyncQueriesDone" and so far the testing I've done appears to function as I needed it to.

Much appreciated for everyone's help!

dsmith616 · Jun 16th 2016

Re: Call Function only working when Step Thru

Quote from rory;772609

Typically, this means that your connections are set to refresh in the background. What that means is that your code continues running before the tables are refreshed, and therefore there isn't any data for it to process. You need to turn off the background querying.

Thanks for the tip rory. Originally I tried using 'DoEvents' which didn't work then I tried adding a delay and failed as well. However, based on your response I did a little more research and found a new option called "Application.CalculateUntilAsyncQueriesDone" and so far the testing I've done appears to function as I needed it to.

Much appreciated for everyone's help!

dsmith616 · Jun 15th 2016

Re: Call Function only working when Step Thru

If I'm understanding what you're saying correctly, then you're correct. Let me try to re-iterate to ensure we're on the same page.

Running my Function (or Sub - since I've tried both ways) to add hyperlinks via a Macro button or manually executing using F5 WILL NOT add any hyperlinks to my worksheet.

However, if I add a "red dot" (sorry not sure what this is actually called) next to my CALL and proceed to step through each line it will then most definitely add the hyperlinks as it should.

I've tried adding delays and obviously turning off automatic calculations because I thought it was maybe moving too fast through the code, but neither of those have worked.

dsmith616 · Jun 15th 2016

Re: Call Function only working when Step Thru

Hi skywriter, thanks for the reply.

The purpose of the Function is simply to add Hyperlinks. I did change the function to a sub at one point, but was still seeing the same issue.

dsmith616 · Jun 15th 2016

I can run each piece of code independently of each other and it'll work. I can add a break point and step through each line of code and it'll work fine. HOWEVER, when I attempt to run them together I do not get the same results and can't figure out why. Anyone have any suggestions?

First piece is to update the data in multiple sheets

Code

Sub RefreshConnection()


ActiveWorkbook.Connections("NoTechTeam").Refresh
ActiveWorkbook.Connections("ZeroPriorityPointsBI").Refresh
ActiveWorkbook.Connections("ZeroPriorityPointsMIS").Refresh




Call NoTechTeam.NoTechTeamHL

Display More

Second piece is to add hyperlinks to our internal tracking system. When I execute together it selects the tab but doesn't add any hyperlinks.

Code

Option Explicit








Function NoTechTeamHL()




Application.Calculation = xlCalculationManual




Worksheets("NoTechTeam").Activate




     
Dim dm As Range
Dim title As Range








Dim r As Integer
Dim c As Integer




r = Range("NoTechTeam[[#Headers],[DM]]").Row
c = Range("NoTechTeam[[#Headers],[DM]]").Column
Dim rng As Range
Set rng = Cells(r, c)








Dim url As String
url = "http://intranetamericas.cshare.net/us/cts/SLS/SLSProjects/Lists/Development%20Requirement/DispForm.aspx?ID="
















Dim lastRow As Long
lastRow = GetLastRow(rng)








Dim i As Integer
For i = 2 To lastRow
    
    Dim currentRng, anchorRng As Range
    




    Set currentRng = Cells(i, c)
    




    Set anchorRng = Cells(i, c)
    
    Set dm = Range("A" & i)




    
    'Add Hyperlink
    currentRng.HyperLinks.Add Anchor:=anchorRng, _
        Address:=url & dm.Value2, _
        ScreenTip:="SharePoint Demand Mangement"




Next i
 




End Function








Public Function GetLastRow(incomingRng As Range)




    GetLastRow = incomingRng.End(xlDown).Row
    
End Function

Display More

dsmith616 · May 19th 2016

Re: VLookUp Help

Because I will not be the individual working on said report/issues it needs to be a "living" document and able to update itself without my intervention each day.

After playing around with some code snippets I was able to piece some things together to make it work. However, it does run SLOW! That would be my only qualm at this point. In case anyone is interested; here is my solution below.

Code

Sub VLookUp()






'Refreshes SQL connection based on name








ActiveWorkbook.Connections("JudgmentFigureDataReferred").Refresh












'Clears contents in Sheets "Folder" for both Columns A & B
    
    Worksheets("Folder").Select
    Range("A2:C2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents












'Pulls in name for each file in specified folder location




Dim ctr As Integer
Dim path As Variant
Dim file As Variant
ctr = 1
path = "J:\DefaultManagement\Timeline Management\Foreclosure Bid Approval\JFIGS\ "   ' Path should always contain a '\' at end
file = Dir(path)    ' Retrieving the first entry.
Do Until file = ""   ' Start the loop.
  Worksheets("Folder").Cells(ctr + 1, 1).Value = Left(file, 10)
  ctr = ctr + 1
  file = Dir()   ' Getting next entry.
Loop








'Adds VLookUp Formula to Column B in Sheet "Folder"




Worksheets("Folder").Range("B2").Select




Range("B2").FormulaR1C1 = "=VLOOKUP(DATA!RC[-1],C[-1],1,FALSE)"




Selection.AutoFill Destination:=Range("B2:B" & Range("A" & Rows.Count).End(xlUp).Row)








'Adds VLookUp Formula to Column C in Sheet "Folder" to pull in Good Through Date




Worksheets("Folder").Range("C2").Select




Range("C2").FormulaR1C1 = "=VLOOKUP(RC[-1],DATA!C[-2]:C[8],11,FALSE)"




Selection.AutoFill Destination:=Range("C2:C" & Range("B" & Rows.Count).End(xlUp).Row)








'Refreshes Pivot Table




Dim pt As PivotTable




Set pt = Worksheets("Pivot").PivotTables("JFIGS")




pt.RefreshTable
























End Sub

Display More

dsmith616 · May 17th 2016

I can't get this VLookUp formula to apply to my column.

Brief background:
Tab "DATA" has SQL data being pulled in on a refreshed connection.
Tab "Folder" pulls a list of file names from a designated folder; all in Column A.
In the "Folder" tab, Column B, I'd like to add the VLookUp formula, but when I recorded the macro it still will not apply to all the cells only the first cell (B2).

I can find the lastrow, but not sure why the formula isn't apply to every cell. In the For Loop is my feeble attempts at adding the formula in each cell.

Code

Option Explicit






Sub VLookUp()
'




'
Dim lastRow As Long




Worksheets("Folder").Select
lastRow = GetLastRow("A2")
MsgBox ("The last row is " & lastRow)








Dim i As Integer
For i = 2 To lastRow




'    Range("B2").Select
'    Range("B2" & lastRow).FormulaR1C1 = _
'        "=VLOOKUP(Table1[[#This Row],[LoanNumber]],Folder!C[-1],1,FALSE)"
''    Range("B2").Select
''    Selection.AutoFill Destination:=Range("B2:B4")




'Range("B2").FormulaR1C1 = _
'        "=VLOOKUP(Table1[[#This Row],[LoanNumber]],"Folder!C[-1] & lastRow",1,FALSE)"




Next i
 




End Sub
















Public Function GetLastRow(incomingRng As String)
    GetLastRow = Range(incomingRng).End(xlDown).Row
End Function

Display More

dsmith616 · Apr 28th 2016

Re: Add Hyperlinks Dynamically

I'm going to include the code that I "attempted" along with a data sample to see if that helps.

I receive an error on the currentRng and anchorRng. Not sure what else to try.

Code

Option Explicit






Sub Macro1()
'
' Macro1 Macro
'




Dim ControlFind As String
ControlFind = "WebAddress"
Dim LinkRng As Range
Set LinkRng = Cells.Find(What:=ControlFind)




Dim url As String
url = "http://intranetamericas.cshare.net/us/cts/SLS/SLSProjects/Lists/Development%20Requirement/DispForm.aspx?ID="








'This will go to cell I2, and get the last row
Dim lastRow As Long




lastRow = GetLastRow.Offset(0, 1)
MsgBox ("The last row is I" & lastRow)




Dim i As Integer
For i = 2 To lastRow
    
    Dim currentRng As Range
    Dim anchorRng As Range
    
    
    
    'I2, I3, I4....etc till the loop hits 'lastRow'
[COLOR=#ff0000][B]Set currentRng = (lastRow & i)[/B][/COLOR]
    
    'K2, K3, K4....respective to currentRng
[COLOR=#ff0000][B]Set anchorRng = (lastRow & i)[/B][/COLOR]
    
    Dim dm As Range
    Dim title As Range
    Set dm = Range("A" & i)
    Set title = Range("B" & i)
    
    'Add Hyperlink
    currentRng.Hyperlinks.Add Anchor:=anchorRng, _
        Address:=url & dm.Value2, _
        ScreenTip:="SharePoint Demand Mangement", _
        TextToDisplay:=dm.Value2 & " - " & title.Value2
Next i
 
End Sub












'
'    Cells.Find(What:="WebAddress", After:=ActiveCell, LookIn:=xlFormulas, _
'        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
'        MatchCase:=False, SearchFormat:=False).Activate
















Public Function GetLastRow(LinkRng As String)
    GetLastRow = Range(LinkRng).End(xlDown).Row
End Function

Display More

dsmith616 · Apr 28th 2016

I've been successful using the code below adding hyperlinks when I know where the information will be (i.e. a specific column). However, I'm looking to alter this to search by header names to the column to create the link. Reason being is many reports are created and depending on who or what columns of information is needed it may differ each time. Thanks for any feedback.

Code

Option Explicit










Sub HyperLink()








Dim dm As Range
Dim title As Range




Dim url As String
url = "www.microsoft.com"








'This will go to cell I2, and get the last row
Dim lastRow As Long




lastRow = GetLastRow("I2")
'MsgBox ("The last row is I" & lastRow)




Dim i As Integer
For i = 2 To lastRow
    
    Dim currentRng, anchorRng As Range
    
    'I2, I3, I4....etc till the loop hits 'lastRow'
    Set currentRng = Range("I" & i)
    
    'K2, K3, K4....respective to currentRng
    Set anchorRng = Range("I" & i)
    
    Set dm = Range("A" & i)
    Set title = Range("B" & i)
    
    'Add Hyperlink
    currentRng.Hyperlinks.Add Anchor:=anchorRng, _
        Address:=url & dm.Value2, _
        ScreenTip:="SharePoint Demand Mangement", _
        TextToDisplay:=dm.Value2 & " - " & title.Value2
Next i
 
End Sub




Public Function GetLastRow(incomingRng As String)
    GetLastRow = Range(incomingRng).End(xlDown).Row
End Function

Display More

dsmith616 · Mar 29th 2016

Trying to add hyperlinks into my worksheet, but can't get passes this run-time error 438

Code

Option Explicit






Sub HyperLink()








Dim ws As Worksheet
Dim rng As Range
Dim cell As Range




Set ws = Worksheets("DATA")
[B]Set rng = Range(Range("I2"), Range("I2").End(xlDown)).Selection [/B]this is where the error is happening








For Each rng In ws
    With rng
     .Hyperlinks.Add Anchor:=Cells(cell.Column + 1), _
     Address:="http://example.microsoft.com", _
     ScreenTip:="Microsoft Web Site", _
     TextToDisplay:="Microsoft"
    End With




Next rng
















End Sub

Display More

dsmith616 · Feb 9th 2016

First and foremost, I am using Outlook 2007 and creating a rule does and has not worked for this.

I receive automated messages that I am attempting to organize and I'm guessing how the e-mails are formatted the regular Outlook rules are not able to pick it up and move accordingly. So I was hoping there was a workaround for this using VBA on incoming e-mails to only run based on a specific e-mail address for incoming messages.

Any thoughts?

dsmith616 · Dec 16th 2015

I'm not exactly sure if this would be an IF statement (or if that's what it's called in VBA). However, I have this really small code snippet below:

Code

With Sheets("DISTRIBUTION")        
.ShowAllData
End With

What I'd like to do is re-write this so in the event that all the data is already shown (nothing filtered) it will not cause the code to break. As it stands this will only work if the data has been filtered.

dsmith616 · Dec 4th 2015

Re: using VBA with fluctuating table sizes

I was thinking the same thing StephenR that I may have to utilize a button. Which I did and so far so good, I've been able to complete all the tasks I outlined in a prior post. Thanks for that last code snippet to tie the rest into working order!

Happy Friday!

:cheers:

dsmith616 · Dec 4th 2015

Re: using VBA with fluctuating table sizes

I tried this code and it worked on its own, but not with the Worksheet Change Event

Code

Private Sub Worksheet_Change(ByVal Target As Range)     
    If Target.Address = "$B$1" Then
    
        Sheets("DATA").Range("E2").Activate
        
        With Selection
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Sheets("FC Payment Research").Range("B4").PasteSpecial Paste:=xlPasteFormulas
            Sheets("FC Payment Research").Cells.EntireColumn.AutoFit
        End With




    End If
     
End Sub

Display More

Also tried this variation with no luck.

Code

Private Sub Worksheet_Change(ByVal Target As Range)     
    If Target.Address = "$B$1" Then
    
        Sheets("DATA").Activate
        Range("E2").Select
        With Selection
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Sheets("FC Payment Research").Range("B4").PasteSpecial Paste:=xlPasteFormulas
            Sheets("FC Payment Research").Cells.EntireColumn.AutoFit
        End With
        




    End If
     
End Sub

Display More

dsmith616 · Dec 4th 2015

Re: using VBA with fluctuating table sizes

I only need to copy a specific range over, not the entire page that's why there were these lines:

Code

[COLOR=#333333]        Range(Selection, Selection.End(xlToRight)).Select 
[/COLOR][COLOR=#333333]        Range(Selection, Selection.End(xlDown)).Select [/COLOR]

Posts by dsmith616

Displaying File 'Comments' in (Properties > Details) with Excel VBA

Copy row to new sheet based on cell value

Copy row to new sheet based on cell value

Extract multiple numeric value sets

Extract multiple numeric value sets

Call Function only working when Step Thru

Call Function only working when Step Thru

Call Function only working when Step Thru

Call Function only working when Step Thru

Call Function only working when Step Thru

VLookUp Help

VLookUp Help

Add Hyperlinks Dynamically

Add Hyperlinks Dynamically

Object doesn't support this property or method

Outlook VBA - Move to Folder based on text in Body

VBA IF Statement?

using VBA with fluctuating table sizes

using VBA with fluctuating table sizes

using VBA with fluctuating table sizes