Jimi Sherman
asked on
How would I sum a VBA dim?
The macro I have has a "Dim sAcct, sAddress, sBillCode As String"
I need to take the sAcct and add today's date to it in this format "mmddyyy".
Example: ABCD = sAcct so it needs to be like this ABCD10052014.
If someone needs to whole macro I will upload it.
Thanks,
Jimi
I need to take the sAcct and add today's date to it in this format "mmddyyy".
Example: ABCD = sAcct so it needs to be like this ABCD10052014.
If someone needs to whole macro I will upload it.
Thanks,
Jimi
Jimi
This will add the date in the specified format to the existing value in sAcct.
To declare all 3 variables as String you would need something like this.
This will add the date in the specified format to the existing value in sAcct.
sAcct = sAcct & Format(Date(), "mmddyyyy")
PS In your declaration only sBillCode is being declared as String. To declare all 3 variables as String you would need something like this.
Dim sAcct As String , sAddress As String, sBillCode As String
try
Dim thisDate As Date
Dim sAcct As String, sAddress As String, sBillCode As String
thisDate = Today
sAcct & thisDate
you can also try
Dim myDate as Date = Date.Now()
Dim sDate as String = myDate.ToString("mmDDyyyy")
sAcct & sDate
ASKER
Sorry I left out an important part.
I will be adding this to the macro...Dim sWorkID As String
So the sWorkID will be = sAcct & Format(Date(), "mmddyyyy")
I have tried this but it does not work...sWorkID = sAcct & Format(Now(), "mmddyyyy")
The results is just the date format without the acct number.
I will be adding this to the macro...Dim sWorkID As String
So the sWorkID will be = sAcct & Format(Date(), "mmddyyyy")
I have tried this but it does not work...sWorkID = sAcct & Format(Now(), "mmddyyyy")
The results is just the date format without the acct number.
you need to populate sAcct first
Dim myDate as Date = Date.Now()
Dim sDate as String = myDate.ToString("mmDDyyyy")
sAcct = something_you_need_ to_compute
sAcct & sDate
Post your whole code please
ASKER
Sub BH_Enter_SerialNumber_ORLANDO()
Dim sWorkbookName As String
Dim sWorkbookName2 As String
Dim sWorkbookNamePath As String
Dim sWorkbookNamePath2 As String
Dim sScanSerial As String
Dim fCell, dCell, lCell, eCell, cCell, nCell, oCell, pCell As String
Dim iRow As Long
Dim sAcct, sAddress, sBillCode As String
Dim sContractor As String
Dim sMarket As String
Dim sTechID As String
Dim sFlag As String
Dim sLOB As String
Dim sTaskQuanity As String
Dim sWorkID As String
Dim iRet As Integer
sContractor = "LABS"
sMarket = "CFL"
sTechID = "1234"
sFlag = "Y"
sLOB = "COL"
sTaskQuanity = "1"
sWorkID = sAcct & Format(Now(), "mmddyyyy") 'THIS IS THE PART I NEED HELP WITH
On Error Resume Next
'Application.DisplayAlerts = False
sWorkbookName = ThisWorkbook.Name
Windows(sWorkbookName).Activate
sWorkbookNamePath = ActiveWorkbook.FullName
sWorkbookName2 = IsWbOpen(sContractor & "-Orlando_Returned_EQ")
If sWorkbookName2 = "" Then
iRet = MsgBox("Start a New Equipment Scan spreadsheet?", vbYesNo, "Box Serial Lookup")
If iRet = 7 Then
ChDrive Left(sWorkbookNamePath, 3)
ChDir Left(sWorkbookNamePath, InStrRev(sWorkbookNamePath, "\"))
filetoopen = Application.GetOpenFilename(Title:="Please choose a Return file to add to", FileFilter:=sContractor & "-Orlando_Returned_EQ (*.xlsx),")
If filetoopen = False Then
Beep
MsgBox "No file specified.", vbExclamation, "Error!"
Exit Sub
Else
sWorkbookNamePath2 = filetoopen
Workbooks.Open (sWorkbookNamePath2)
End If
Else
sWorkbookNamePath2 = Left(sWorkbookNamePath, InStrRev(sWorkbookNamePath, "\")) & sContractor & "-Orlando_Returned_EQ_" & Format(Date, "yyyy-mm-dd") & ".xlsx"
If FileOrDirExists(sWorkbookNamePath2) Then
'Workbooks.Open Filename:=sWorkbookNamePath2
Workbooks.Open (sWorkbookNamePath2)
Else
Workbooks.Add
Range("A1").Select
ActiveCell.FormulaR1C1 = "Work Order ID"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Contractor Abb"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Market Abb"
Range("D1").Select
ActiveCell.FormulaR1C1 = "WA Tech ID"
Range("E1").Select
ActiveCell.FormulaR1C1 = "WO Close Date"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Flag Reporting"
Range("G1").Select
ActiveCell.FormulaR1C1 = "LOB"
Range("H1").Select
ActiveCell.FormulaR1C1 = "TASK Code"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Task Code Quanity"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Start Date"
Range("K1").Select
ActiveCell.FormulaR1C1 = "End Date"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Arrival Time"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Job Notes (Serials)"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Acc #"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Address"
Range("P1").Select
ActiveCell.FormulaR1C1 = "City"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "State"
Range("R1").Select
ActiveCell.FormulaR1C1 = "ZIP"
Range("S1").Select
ActiveCell.FormulaR1C1 = "Amount Owed"
Range("T1").Select
ActiveCell.FormulaR1C1 = "Amount Collected"
Range("U1").Select
ActiveCell.FormulaR1C1 = "Market Area Abb"
'format
Columns("E:E").Select
Selection.NumberFormat = "mm/dd/yyyy"
Columns("J:K").Select
Selection.NumberFormat = "mm/dd/yyyy"
Range("B2").Select
Columns("M:M").Select
Selection.NumberFormat = "@"
ActiveWorkbook.SaveAs Filename:=sWorkbookNamePath2, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End If
End If
sWorkbookName2 = ActiveWorkbook.Name
Else
sWorkbookNamePath2 = Left(sWorkbookNamePath, InStrRev(sWorkbookNamePath, "\")) & sWorkbookName2
End If
Windows(sWorkbookName).Activate
Sheets("Merge").Select
'Application.DisplayAlerts = True
'Application.ScreenUpdating = True
Windows(sWorkbookName2).Activate
iRow = Cells(Rows.Count, "B").End(xlUp).Row + 1
Range("A" & iRow).Select
Reenter:
sScanSerial = InputBox("Scan or type equipment serial number", "Serial Number Processor")
sScanSerial = Replace(sScanSerial, "*", "")
If Len(Trim(sScanSerial)) < 5 And Len(Trim(sScanSerial)) > 0 Then
Beep
MsgBox "Serial numbers need to be at least 5 characters.", vbOKOnly, "Illegal entry error"
GoTo Reenter
End If
While sScanSerial > ""
Windows(sWorkbookName).Activate
cCell = "C" 'Mt Area
dCell = "D" 'Acct number from list
eCell = "E" 'Billing Code
lCell = "L" 'ADDRESS from list
nCell = "N" 'City
oCell = "O" 'State
pCell = "P" 'Zip
fCell = "M1" 'Serial Number added to log
Range(fCell).Select
Cells.Find(What:=sScanSerial, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False).Activate
If ActiveCell.Address <> "$M$1" Then
Range(cCell & Mid(ActiveCell.Address, 4, 8)).Select
sMtArea = ActiveCell.FormulaR1C1
Range(dCell & Mid(ActiveCell.Address, 4, 8)).Select
sAcct = ActiveCell.FormulaR1C1
Range(eCell & Mid(ActiveCell.Address, 4, 8)).Select
sBillCode = ActiveCell.FormulaR1C1
Range(lCell & Mid(ActiveCell.Address, 4, 8)).Select
sAddress = ActiveCell.FormulaR1C1
Range(nCell & Mid(ActiveCell.Address, 4, 8)).Select
sCity = ActiveCell.FormulaR1C1
Range(oCell & Mid(ActiveCell.Address, 4, 8)).Select
sState = ActiveCell.FormulaR1C1
Range(pCell & Mid(ActiveCell.Address, 4, 8)).Select
sZip = ActiveCell.FormulaR1C1
Windows(sWorkbookName2).Activate
Range("B" & iRow).Select
ActiveCell.FormulaR1C1 = sContractor
Range("C" & iRow).Select
ActiveCell.FormulaR1C1 = sMarket
Range("D" & iRow).Select
ActiveCell.FormulaR1C1 = sTechID
Range("E" & iRow).Select
ActiveCell.FormulaR1C1 = Date
Range("F" & iRow).Select
ActiveCell.FormulaR1C1 = sFlag
Range("F" & iRow).Select
ActiveCell.FormulaR1C1 = sFlag
Range("G" & iRow).Select
ActiveCell.FormulaR1C1 = sLOB
Range("H" & iRow).Select
ActiveCell.FormulaR1C1 = sBillCode
Range("I" & iRow).Select
ActiveCell.FormulaR1C1 = sTaskQuanity
Range("J" & iRow).Select
ActiveCell.FormulaR1C1 = Date
Range("K" & iRow).Select
ActiveCell.FormulaR1C1 = Date
Range("M" & iRow).Select
ActiveCell.FormulaR1C1 = sScanSerial
Range("N" & iRow).Select
ActiveCell.FormulaR1C1 = sAcct
Range("O" & iRow).Select
ActiveCell.FormulaR1C1 = sAddress
Range("P" & iRow).Select
ActiveCell.FormulaR1C1 = sCity
Range("Q" & iRow).Select
ActiveCell.FormulaR1C1 = sState
Range("R" & iRow).Select
ActiveCell.FormulaR1C1 = sZip
Range("U" & iRow).Select
ActiveCell.FormulaR1C1 = sMtArea
Range("A" & iRow).Select
ActiveCell.FormulaR1C1 = sWorkID
Else
'MsgBox "The Serial number scanned [" & sScanSerial & "] was not found!!! Adding as Found Box"
Beep
Windows(sWorkbookName2).Activate
Range("B" & iRow).Select
ActiveCell.FormulaR1C1 = sContractor
Range("N" & iRow).Select
ActiveCell.FormulaR1C1 = "Found Box"
Range("M" & iRow).Select
ActiveCell.FormulaR1C1 = sScanSerial
Range("E" & iRow).Select
ActiveCell.FormulaR1C1 = Date
End If
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("N1:N1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A:U")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("A:U").Select
Columns("A:U").EntireColumn.AutoFit
Range("A" & iRow & ":U" & iRow).Select
iRow = iRow + 1
ReenterB:
sScanSerial = InputBox("Scan or type equipment serial number", "Serial Number Processor")
If StrPtr(sScanSerial) = 0 Then
Windows(sWorkbookName2).Activate
Rows("1:1").Select
Selection.Font.Bold = True
Columns("B:C").Select
Columns("B:C").EntireColumn.AutoFit
Columns("C:C").Select
Selection.NumberFormat = "@"
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("N1:N1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A:U")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B1:C1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B1").Select
Windows(sWorkbookName).Activate
Range("B2").Select
Else
sScanSerial = Replace(sScanSerial, "*", "")
If Len(Trim(sScanSerial)) < 5 And Len(Trim(sScanSerial)) > 0 Then
Beep
MsgBox "Serial numbers need to be at least 5 characters.", vbOKOnly, "Illegal entry error"
GoTo ReenterB
End If
End If
Wend
'Application.ScreenUpdating = True
End Sub
Function FileOrDirExists(PathName As String) As Boolean
Dim iTemp As Integer
On Error Resume Next
iTemp = GetAttr(PathName)
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
On Error GoTo 0
End Function
Function IsWbOpen(wbName As String) As String
Dim i As Long
IsWbOpen = ""
For i = Workbooks.Count To 1 Step -1
If InStr(1, Workbooks(i).Name, wbName) > 0 Then
IsWbOpen = Workbooks(i).Name
Exit For
End If
Next
End Function
sContractor = "LABS"
sMarket = "CFL"
sTechID = "1234"
sFlag = "Y"
sLOB = "COL"
sTaskQuanity = "1"
sWorkID = sAcct & Format(Now(), "mmddyyyy") 'THIS IS THE PART I NEED HELP WITH
You haven't set sAcct to anything prior to using it. What are you expecting it will contain?
Why use Now, that returns the date and time?
ASKER
It will get the Acct number from a list and put it in another worksheet.
This is line 147 and 148 of the code...
Range(dCell & Mid(ActiveCell.Address, 4, 8)).Select
sAcct = ActiveCell.FormulaR1C1
This is line 147 and 148 of the code...
Range(dCell & Mid(ActiveCell.Address, 4, 8)).Select
sAcct = ActiveCell.FormulaR1C1
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I see a couple of conditions
While sScanSerial > ""
....
...
If ActiveCell.Address <> "$M$1" Then
you are getting a serial number as input. This needs to be a non-empty string and then the active cell should not be M1
ASKER
James that worked perfect!
Thanks
Thanks
Open in new window