I am looking for help to teach me how to create message box base on this
value:
=IF(F2<=TODAY(), "EXPIRED", IF(AND(F2-TODAY()>0, F2-TODAY()>=10), "ACTIVE", "REMINDER"))
I wish the message box will appear once I open the excel file which all under 'Reminder" only with a number. The message box will be such as "32 Reminder found in XLMembership" base on counting result.
Since no one interesting to answer my question then I answer it myself and sharing to user who looking an answer on same question..
Private Sub Workbook_Open()
Dim Ret_type As Integer
Dim strMsg As String
Dim strTitle As String
Dim iReminders As Long
iReminders = WorksheetFunction.CountIf(Columns("B"), "REMINDER")
MsgBox Format(iReminders, "#,##0") & " REMINDER found in XLMembership", vbInformation + vbOK
End Sub
Related
Created this very simple code - however guess not too elegant, maybe there are much more logical solutions but me is not a vba expert - which has to copy only visible data ranges from source to data workbook after filtering.
Code is working but the part where has to copy/paste there is a message with run time error 1004 / which shows that copy and paste area are not the same...doesnt understand as made originally a test and worked but with the final files do not...sucking on this for days and cannot solve:/
Further all these details has to be paste without header which I cannot handle however read over many on your page with similar request but cannot find a real solution or doesnt understand:/
Tried with offset but cannot work if simply put it into the rows like this
Cells.SpecialCells(xlCellTypeVisible).offset(1.0)
Many thx in advance for your valuable help
Sub CALL_REPORT()
Dim wbLCLHU As Workbook: Set wbLCLHU = Workbooks("SOURCE.xlsm")
Dim wsLCLHU As Worksheet: Set wsLCLHU = wbLCLHU.Sheets("ENTRY")
Dim rngLCLHU As Range: Set rngLCLHU = wsLCLHU.Range("A:CE")
Dim wbCallLCL As Workbook: Set wbCallLCL = Workbooks("COLLECT.xlsx")
Dim wsCallLCL As Worksheet: Set wsCallLCL = wbCallLCL.Sheets("LCL")
Dim rngCallLCL As Range: Set rngCallLCL = wsCallLCL.Range("A:V")
Dim lastrowCall As Long
lastrowCall = rngCallLCL(rngCallLCL.Rows.Count, "H").End(xlUp).Row + 1
'Remove filter that was applied.
Workbooks("SOURCE").Sheets("ENTRY").AutoFilterMode = False
With rngLCLHU
.autofilter Field:=37, Criteria1:=(BLanks)
.autofilter Field:=83, Criteria1:=(BLanks)
End With
Dim rngLCLHUSPOT As Range
Set rngLCLHUSPOT = Range("H:H").Cells.SpecialCells(xlCellTypeVisible)
rngLCLHUSPOT.copy
wsCallLCL.Range("I" & lastrowCall).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Dim rngLCLHUSHIPPER As Range
Set rngLCLHUSHIPPER = Range("M:M").Cells.SpecialCells(xlCellTypeVisible)
rngLCLHUSHIPPER.copy
wsCallLCL.Range("E" & lastrowCall).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'followed by many times copy paste with different ranges, method same of each as above
'and above printed full method repeat as much as many source I have
End
I have a MS Access 2013 memo field that I use to hold text versions of
email. Here is an example:
From: Simon Smith
To: Bob Brown
Date: 5/4/15 2:30PM
Subject: Draft Report
Please find attached the draft report as discussed.
I want to extract the data (i.e. "Draft Report") from the email field "Subject:" from a memo field to a text field on an MS Access form.
Can anyone help?
Thankyou GM
Ok. I have figured it out using Instr and Mid. Thankyou for your suggestion Gord. I'm sure there is better way to do it but it works!
Dim strStart As String
Dim strEnd As String
' figure out where the string starts
strStart = InStr(Me.EmailMemo, "Subject:") + 9
' figure out where the line ends by looking for a carriage return
strEnd = InStr(strStart, Me.EmailMemo, Chr(10))
' display the string
Me.EmailTitle = Mid(Me.EmailMemo, strStart, strEnd - strStart)
I've seen this method over the internet: Create Short URLs Using APIs and Google Docs
How can I use this method using www.tinyurl.com?
Can you please help me? thank you!
No credentials are required to access the tinyurl api. It is dead simple, requiring only the long url in the query:
http://tinyurl.com/api-create.php?url=<longUrl>
A spreadsheet function similar to those in the referenced article would be:
= importData(concatenate("http://tinyurl.com/api-create.php?url=",B1))
Reference: Tinyurl has an API.
=importData is only for googlesheets.
Which answers this question.
But for those who use Excel you can use VBA code
Option Explicit
Public Sub tinyURL()
Dim qt As QueryTable
Dim ws As Worksheet
Dim Copy As Integer
Dim Paste As Integer
Dim i As Integer
Dim URL As String
i = 2
Copy = 2
Paste = 2
Set ws = ThisWorkbook.Worksheets("Sheet1")
'loops until column A is empty
Do Until IsEmpty(Cells(i, 1))
'Copy from list in Column A and paste result into column B
URL = "INSERT THE TINYURL API URL HERE ENDING WITH =" & Range("A" & Copy)
Set qt = ws.QueryTables.Add(Connection:="URL;" & URL, Destination:=ws.Range("B" & Paste))
With qt
.RefreshOnFileOpen = True
.FieldNames = True
.WebSelectionType = xlSpecifiedTables
.WebTables = 1
.Refresh BackgroundQuery:=False
End With
i = i + 1
Copy = Copy + 1
Paste = Paste + 1
Loop
End Sub
So, I want to make it so that, when the user pastes something into a textbox, once it pastes the first 24 characters into that textbox, it will send the rest to a richtextbox.
I've tried splitting, joining, with no luck. I don't know what else I can do. Any ideas?
I've tried:
If TextBox1.Text > TextBox1.MaxLength Then
RichTextBox4.Text = TextBox1.Text
End If
And some other weird things that didn't work out. I would appreciate some help.
Thank you.
use Substring....
Dim input = textbox1.text
Dim substring As String = input .Substring(0, 24)
richtextbox4.text = substring
http://www.dotnetperls.com/substring-vbnet
I would like to set the filename for an item I create in an Excel Document Library. Howeverm when I try to interfere with the standard save with my own filename, it wants to save to my LOCAL MACHINE. I would happily like to supply the PATH if that is necessary, but I really DONT WANT TO HARD CODE IT.
Are there any properties I can use to parse this info? Meta data? Template?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then
Sheets("Purchase Order").Range("Description,VendorInfo,QUANTITY1,PRODUCT1,ITEM1,PRICE1,submitter,ShipVia,Terms,MACRO_ALERT").Interior.ColorIndex = xlColorIndexNone
Sheets("Purchase Order").Range("Location").Interior.Color = RGB(184, 204, 228)
Sheets("Purchase Order").Range("MACRO_ALERT").Value = ""
Dim MyFileName As String
Dim MyFilePath As String
' MyFilePath = "http://server/dept/purchasetracking/"
MyFilePath = Application.Path
MyFileName = "PO_" & Format(Now(), "yyyymmdd-hhnnss")
MsgBox (MyFilePath & MyFileName)
ActiveWorkbook.SaveAs Filename:=MyFilePath & MyFileName ', FileFormat:=52
' ActiveWorkbook.SaveAs Filename:=MyFileName
End If
End Sub
I like to use function GetSetting() and statement SaveSetting to save such informations to the registry (last used path, etc.).
When the file is opened from a SHP folder, ActiveWorkbook.Path starts with "http://". In this case you could save this path from a Sub Workbook_Open() procedure into the registry to retain the SHP path information. This can be later on used to offer a good path/filename to the user.
Hope that helps .... Good Luck MikeD