Link to home
Start Free TrialLog in
Avatar of Jimi Sherman
Jimi ShermanFlag for United States of America

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
Avatar of James Elliott
James Elliott
Flag of United Kingdom of Great Britain and Northern Ireland image

sAcct = sAcct & format(now(),"mmddyyyy")

Open in new window

Avatar of Norie
Norie

Jimi

This will add the date in the specified format to the existing value in sAcct.
sAcct = sAcct & Format(Date(), "mmddyyyy")

Open in new window

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

Open in new window

try

Dim thisDate As Date
Dim sAcct As String, sAddress As String, sBillCode As String

thisDate = Today
sAcct & thisDate 

Open in new window

you can also try

Dim myDate as Date = Date.Now()
Dim sDate as String = myDate.ToString("mmDDyyyy")
sAcct & sDate

Open in new window

Avatar of Jimi Sherman

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.
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

Open in new window

Post your whole code please
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

Open in new window

    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

Open in new window


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?
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
ASKER CERTIFIED SOLUTION
Avatar of James Elliott
James Elliott
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I see a couple of conditions

While sScanSerial > ""
....
...
If ActiveCell.Address <> "$M$1" Then

Open in new window

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
James that worked perfect!
Thanks