Need a real VBA equivalent for Excel Value function - vba

As mentioned in the title, I need a VBA equivalent to the Excel Value function. My data set looks like this: Data set example
What I am looking for is VBA code equivalent to this: =Value(A2)+Value(B2). That would go in column C
The output must be the same as that function. For the given example, column C should end up looking like this: End product
More than that, it needs to only have the value in the cell after the macro is run, rather than displaying the value and still having that formula in it.
Here is what I have done so far:
For i = 1 To LastRow
strValue = Val(sht.Range("A" & i))
strValue1 = Val(sht.Range("B" & i))
sht.Range("C" & i).Value = strValue + strValue1
Next i
I also tried variations on this, a couple of which are shown below:
For i = 1 To LastRow
strValue = Evaluate(sht.Range("A" & i))
strValue1 = Evaluate(sht.Range("B" & i))
sht.Range("C" & i).Value = strValue + strValue1
Next i
For i = 1 To LastRow
strValue = sht.Range("A" & i)
strValue1 = sht.Range("B" & i)
strVal = Evaluate(strValue)
strVal1 = Evaluate(strValue1)
sht.Range("C" & i).Value = strVal + strVal1
Next i
I can't find anything that will work for me. The output in C for the example set ends up being just 9. Pretty sure it is taking the first number in A and adding it to the first number in B. So when the hour in B changes to 1 C displays 10.
I also tried simply:
For i=1 To LastRow
sht.Range("C" & i).Value = sht.Range("A" & i).Value + sht.Range("B" & i).Value
Next i
That just concatenated the text to the format 9/03/15 00:00:00
Any and all help appreciated. Bonus if you can point me in the right direction for changing the final C values from that number (ie. 42250.00017) to the custom date/time format 'yyyy-mm-dd hh:mm:ss'.
Edit: Here is my code up to the sticking point. Everything else works as I want it to, the only problem is with the last For loop.
Sub sbOrganizeData()
Dim i As Long
Dim k As Long
Dim sht As Worksheet
Dim LastRow As Long
Dim sFound As String
Dim rng As Range
Dim sheet As Worksheet
Dim Sheet2 As Worksheet
Dim strFile As String
Dim strCSV As String
Dim strValue As Double
Dim strValue1 As Double
Dim strVal As Long
Dim strVal1 As Long
Application.DisplayAlerts = False
Sheets("all016").Delete
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
Set sheet = Sheets.Add
Set Sheet2 = Sheets.Add
sheet.Name = "all016"
Sheet2.Name = "Sheet1"
strFile = ActiveWorkbook.Path
strCSV = "*.csv"
sFound = Dir(strFile & "\*.csv")
If sFound <> "" Then
Workbooks.Open Filename:=strFile & "\" & sFound
End If
Range("A1").CurrentRegion.Copy Destination:=Workbooks("solar.xlsm").Sheets("all016").Range("A1")
Workbooks(sFound).Close
Set sht = ThisWorkbook.Sheets("all016")
LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
sht.Range("C1").EntireColumn.Insert
For i = 1 To LastRow
'Code that doesn't quite work here'
sht.Range("C" & i).NumberFormat = "yyyy-mm-dd hh:mm:ss"
Next i

The issue is that the dates and times are strings so something like this will work:
For i = 2 To LastRow
strValue = Evaluate("VALUE(TRIM(" & sht.Range("A" & i).Address(1,1,,1) & "))")
strValue1 = Evaluate("VALUE(TRIM(" & sht.Range("B" & i).Address(1,1,,1) & "))")
sht.Range("C" & i).Value = strValue + strValue1
'the format
sht.Range("C" & i).NumberFormat = "mm/dd/yy hh:mm:ss"
Next i

You have to reference the .Value2 field of the range element as:
For i = 1 To LastRow
sht.Range("C" & i).Value2 = sht.Range("A" & i).Value2 + sht.Range("B" & i).Value2
Next i
The value is free of formatting and just in Excel's time/date code as you want your final result to be. Cheers,

Related

For each loop to go to next row in iteration once value found in range

All,
I have the below code which iterates through columns and rows to see IF the statement is true. It seems to be running through the whole code bringing back duplicate rows. I would like this code to go to the next row once a value has been found.
I'm unsure how to adapt this code but I imagine the issue lies with the general for each loop I have set up any advise on how to fix this would be much appreciated.
Dim LR As Long
LR = Workbooks(trackerName).Sheets("Results").Range("A1048576").End(xlUp).Row
Dim LRC As Long
LRC = Workbooks(trackerName).Sheets("Columnsforbox").Range("A1048576").End(xlUp).Row + 1
For Each c In Workbooks(trackerName).Sheets("results").Range("A4:K" & LR)
If c.Value = UserName Or c.Value = UserId Then
Worksheets("Columnsforbox").Range("A" & LRC) = Worksheets("Results").Range("E" & c.Row)
Worksheets("Columnsforbox").Range("B" & LRC) = Worksheets("Results").Range("D" & c.Row)
Worksheets("Columnsforbox").Range("C" & LRC) = Worksheets("Results").Range("A" & c.Row)
Worksheets("Columnsforbox").Range("D" & LRC) = Worksheets("Results").Range("B" & c.Row)
Worksheets("Columnsforbox").Range("E" & LRC) = Worksheets("Results").Range("C" & c.Row)
LRC = LRC + 1
End If
Next c
Basicly the same, but now we loop through array:
Dim myArr(), i as Long, j as Long
Dim LR As Long
LR = Workbooks(trackerName).Sheets("Results").Range("A1048576").End(xlUp).Row
Dim LRC As Long
LRC = Workbooks(trackerName).Sheets("Columnsforbox").Range("A1048576").End(xlUp).Row + 1
myArr = Range("A4:K" & LR).Value
For i = LBound(myArr,1) To Ubound(myArr,1)
For j = LBound(myArr,2) To Ubound(myArr,2)
If myArr(i,j) = UserName Or myArr(i,j) = UserId Then
Worksheets("Columnsforbox").Range("A" & LRC) = Worksheets("Results").Range("E" & i)
Worksheets("Columnsforbox").Range("B" & LRC) = Worksheets("Results").Range("D" & i)
Worksheets("Columnsforbox").Range("C" & LRC) = Worksheets("Results").Range("A" & i)
Worksheets("Columnsforbox").Range("D" & LRC) = Worksheets("Results").Range("B" & i)
Worksheets("Columnsforbox").Range("E" & LRC) = Worksheets("Results").Range("C" & i)
LRC = LRC + 1
Exit For
End If
Next j
Next i
Well, you got an idea.
Another solution without using loop.
Sub Demo()
Dim rngUserName As Range, rngUserId As Range
Dim LR As Long, LRC As Long, rowIndex As Long
Dim srcSht As Worksheet, destSht As Worksheet
Set srcSht = Workbooks(trackerName).Sheets("Results") 'this is source sheet
Set destSht = Workbooks(trackerName).Sheets("Columnsforbox") 'this is destination sheet
LR = srcSht.Cells(srcSht.Rows.Count, "A").End(xlUp).Row 'get last row using column A
LRC = destSht.Cells(destSht.Rows.Count, "A").End(xlUp).Row 'get last row using column A
Set rngUserName = Range("A4:K" & LR).Find(UserName, after:=Cells(4, 1), searchdirection:=xlPrevious) 'find user name
Set rngUserId = Range("A4:K" & LR).Find(UserId, after:=Cells(4, 1), searchdirection:=xlPrevious) 'find user id
If Not rngUserName Is Nothing And Not rngUserId Is Nothing Then 'if both user name & user id are found
rowIndex = Application.Max(rngUserName.Row, rngUserId.Row)
ElseIf Not rngUserName Is Nothing Then 'if only user name found
rowIndex = rngUserName.Row
ElseIf Not Not rngUserId Is Nothing Then 'if only user id found
rowIndex = rngUserId.Row
End If
MsgBox rowIndex
destSht.Range("A" & LRC) = srcSht.Range("E" & rowIndex)
destSht.Range("B" & LRC) = srcSht.Range("D" & rowIndex)
destSht.Range("C" & LRC) = srcSht.Range("A" & rowIndex)
destSht.Range("D" & LRC) = srcSht.Range("B" & rowIndex)
destSht.Range("E" & LRC) = srcSht.Range("C" & rowIndex)
End Sub

objReminder.Start = Range("h" & i) not working

I have this code:
Sub StoreReminders()
Dim LastRow As Long
Dim i As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
i = 2
Debug.Print LastRow
Dim appOL As Object
Dim objReminder As Object
Set appOL = GetObject(, "Outlook.application")
Set objReminder = appOL.CreateItem(1) ' olAppointmentItem
For i = 2 To LastRow
Debug.Print i
Debug.Print Range("h" & i)
objReminder.Start = Range("h" & i)
objReminder.Duration = Range("I" & i)
objReminder.Subject = "Renew " & Range("a" & i)
objReminder.ReminderSet = True
objReminder.Save
Next i
End Sub
It breaks at objReminder.Start = Range("h" & i) because according to the Debug.Print code, it is returning the entire column of dates instead of just the date in H2
Does the Range("a" & i) code not work in conjunction with objReminder.Start?
Debug.print prints it out correctly.
If you check the MSDN entry for the Start property then it says:
Returns or sets a Date indicating the starting date and time for the appointment or Journal entry. Read/write.
(their emphasis)
So, in your VBA code, I would change this line:
objReminder.Start = Range("h" & i)
To this:
objReminder.Start = CDate(Range("h" & i).Value)
Using the CDate function which converts a value to a date.

ISNUMBER returning #VALUE! error in formula with VBA

This question is building from the solution found here. I wanted to be able to check if the "LowLimit" cell is a number. If it is then carry out equation, else return value from "MeasValue" column. Here is an example of the data set with my current outcome:
As you can see, the 6th data entry calculation gives the wrong calculation. The number LowLimit value of 22 seems to be hard coded in the formula. Can you help me fix this? Thanks.
Here is the code that I have so far:
Sub ReturnMarginal()
'UpdatebySUPERtoolsforExcel2016
Dim xOut As Worksheet
Dim xWb As Workbook
Dim xWks As Worksheet
Dim InterSectRange As Range
Dim lowLimCol As Integer
Dim hiLimCol As Integer
Dim measCol As Integer
Application.ScreenUpdating = False
Set xWb = ActiveWorkbook
For Each xWks In xWb.Sheets
xRow = 1
With xWks
FindString = "LowLimit"
If Not xWks.Rows(1).Find(FindString) Is Nothing Then
.Cells(xRow, 16) = "Meas-LO"
.Cells(xRow, 17) = "Meas-Hi"
.Cells(xRow, 18) = "Min Value"
.Cells(xRow, 19) = "Marginal"
lastRow = .UsedRange.Rows.Count
lowLimCol = Application.WorksheetFunction.Match("LowLimit", xWks.Range("1:1"), 0)
hiLimCol = Application.WorksheetFunction.Match("HighLimit", xWks.Range("1:1"), 0)
measLimCol = Application.WorksheetFunction.Match("MeasValue", xWks.Range("1:1"), 0)
'If IsNumeric(.Cells(2, lowLimCol).Value2) Then
' .Range("P2:P" & LastRow).Formula = "=" & Cells(2, measLimCol).Address(False, False) & "-" & Cells(2, lowLimCol).Address(False, False)
'Else
' .Range("P2:P" & LastRow).Formula = "=" & Cells(2, measLimCol).Address(False, False)
'End If
.Range("P2:P" & lastRow).Formula = "=IF(ISNUMBER(" & .Cells(2, lowLimCol).Value & ")," & Cells(2, measLimCol).Address(False, False) & "-" & Cells(2, lowLimCol).Address(False, False) & "," & Cells(2, measLimCol).Address(False, False) & ")"
.Range("Q2:Q" & lastRow).Formula = "=" & Cells(2, hiLimCol).Address(False, False) & "-" & Cells(2, measLimCol).Address(False, False)
.Range("R2").Formula = "=min(P2,Q2)"
.Range("R2").AutoFill Destination:=.Range("R2:R" & lastRow)
.Range("S2").Formula = "=IF(AND(R2>=-3, R2<=3), ""Marginal"", R2)"
.Range("S2").AutoFill Destination:=.Range("S2:S" & lastRow)
End If
End With
Application.ScreenUpdating = True 'turn it back on
Next xWks
End Sub
I think the main improvement you can make here is to get the column letters for LowLimit, HighLimit and MeasValue once you establish where they are in row 1. Then you can refer to those column letters when you set the .Formula properties.
There is a helpful post on converting column numbers to letters here.
Also, you don't need to auto-fill columns R and S - you can populate in the same way you are doing for columns P and Q.
I updated your code a little - hope it helps:
Option Explicit
Sub ReturnMarginal()
Dim ws As Worksheet
Dim lngLowLimCol As Long, strLowLimCol As String
Dim lngHiLimCol As Long, strHiLimCol As String
Dim lngMeasCol As Long, strMeasCol As String
Dim lngLastRow As Long
Dim wsf As WorksheetFunction
' get worksheetfunction references
Set wsf = Application.WorksheetFunction
' iterate worksheets
For Each ws In ThisWorkbook.Worksheets
' validate LowLimit label is on sheet
If ws.Rows(1).Find("LowLimit") Is Nothing Then Exit Sub
' get location of input data columns and number of rows
lngLowLimCol = wsf.Match("LowLimit", ws.Rows(1), 0)
lngHiLimCol = wsf.Match("HighLimit", ws.Rows(1), 0)
lngMeasCol = wsf.Match("MeasValue", ws.Rows(1), 0)
lngLastRow = ws.Cells(1, lngLowLimCol).End(xlDown).Row
' get column letters for input data columns
strLowLimCol = Split(ws.Cells(1, lngLowLimCol).Address(True, False), "$")(0)
strHiLimCol = Split(ws.Cells(1, lngHiLimCol).Address(True, False), "$")(0)
strMeasCol = Split(ws.Cells(1, lngMeasCol).Address(True, False), "$")(0)
' output headers
ws.Range("P1") = "Meas-LO"
ws.Range("Q1") = "Meas-Hi"
ws.Range("R1") = "Min Value"
ws.Range("S1") = "Marginal"
' assign formulas to outputs
' Meas-LO
With ws.Range("P2:P" & lngLastRow)
.Formula = "=IF(ISNUMBER(" & strLowLimCol & "2)," & _
strMeasCol & "2-" & strLowLimCol & "2," & _
strMeasCol & "2)"
End With
' Meas-Hi
With ws.Range("Q2:Q" & lngLastRow)
.Formula = "=" & strHiLimCol & "2-" & strMeasCol & "2"
End With
' Min Value
With ws.Range("R2:R" & lngLastRow)
.Formula = "=MIN(P2,Q2)"
End With
' Marginal
With ws.Range("S2:S" & lngLastRow)
.Formula = "=IF(AND(R2>=-3,R2<=3),""Marginal"",R2)"
End With
Next 'ws
End Sub
Output:

Why is my Excel VBA code to copy a cell so slow?

I have 2 worksheets in the same workbook. If a cell in SourceSheet meets certain criteria, I want to copy several non-adjacent cells in the same row to NewSheet. The problem is that it's taking over a half second to paste each and every cell, making the macro far too slow. The code below takes 8 seconds to complete a single loop. Is there a faster way I could do this?
Dim EnrollmentChanges As Range
Dim course1 As Range
Dim course1status As Range
Dim row As Long
Dim lrow As Long
Dim NewSheetRow As Long
'This is a dynamic named range
Set EnrollmentChanges = Sheets("SourceSheet").Range("Source")
NewSheetRow = 0
lrow = Sheets("SourceSheet").Range("A1").End(xlDown).row
For row = 2 To lrow
With EnrollmentChanges
course1 = Sheets("SourceSheet").Range("A" & row)
If course1 <> "" Then
course1status = Sheets("SourceSheet").Range("BS" & row)
If InStr(1, course1, "APEX") And course1status = "1" Then
NewSheetRow = NewSheetRow + 1
Sheets("NewSheet").Range("A" & NewSheetRow) = NewSheetRow
Sheets("NewSheet").Range("B" & NewSheetRow) = "W"
Sheets("NewSheet").Range("C" & NewSheetRow) = "S"
Sheets("NewSheet").Range("D" & NewSheetRow) = "MySchool"
Sheets("SourceSheet").Range("B" & row).Copy Sheets("NewSheet").Range("G" & NewSheetRow)
Sheets("SourceSheet").Range("W" & row).Copy Sheets("NewSheet").Range("H" & NewSheetRow)
Sheets("SourceSheet").Range("V" & row).Copy Sheets("NewSheet").Range("J" & NewSheetRow)
Sheets("SourceSheet").Range("Y" & row).Copy Sheets("NewSheet").Range("K" & NewSheetRow)
Sheets("NewSheet").Range("L" & NewSheetRow) = "OR"
Sheets("SourceSheet").Range("B" & row).Copy Sheets("NewSheet").Range("M" & NewSheetRow)
Sheets("SourceSheet").Range("A" & row).Copy Sheets("NewSheet").Range("P" & NewSheetRow)
End If
Else: GoTo NextRow
End If
End With
NextRow:
Next
The best way to approach this would to be avoiding copy and paste altogether (which are notoriously slow). The only time that copy/paste MAY be worth keeping is when you need to copy formatting. If you just need the values then you can do something like this:
Dim EnrollmentChanges As Range
Dim course1 As Range
Dim course1status As Range
Dim row As Long
Dim lrow As Long
Dim NewSheetRow As Long
'This is a dynamic named range
Set EnrollmentChanges = Sheets("SourceSheet").Range("Source")
NewSheetRow = 0
lrow = Sheets("SourceSheet").Range("A1").End(xlDown).row
For row = 2 To lrow
With EnrollmentChanges
course1 = Sheets("SourceSheet").Range("A" & row)
If course1 <> "" Then
course1status = Sheets("SourceSheet").Range("BS" & row)
If InStr(1, course1, "APEX") And course1status = "1" Then
NewSheetRow = NewSheetRow + 1
With Sheets("NewSheet")
.Range("A" & NewSheetRow).Value = NewSheetRow
.Range("B" & NewSheetRow).Value = "W"
.Range("C" & NewSheetRow).Value = "S"
.Range("D" & NewSheetRow).Value = "MySchool"
.Range("G" & NewSheetRow.Value = Sheets("SourceSheet").Range("B" & row).Value
.Range("H" & NewSheetRow).Value = Sheets("SourceSheet").Range("W" & row).Value
.Range("J" & NewSheetRow).Value = Sheets("SourceSheet").Range("V" & row).Value
.Range("K" & NewSheetRow).Value = Sheets("SourceSheet").Range("Y" & row).Value
.Range("L" & NewSheetRow).Value = "OR"
.Range("M" & NewSheetRow).Value = Sheets("SourceSheet").Range("B" & row).Value
.Range("P" & NewSheetRow).Value = Sheets("SourceSheet").Range("A" & row).Value
End With
End If
' No need for this since you are skipping the operation using the if block
' GoTo is messy and should be avoided where possible as well.
'Else: GoTo NextRow
End If
End With
NextRow:
Next
All I did was swap the order and assign the value directly based on the value retrieved versus storing the value retrieved as a copy, and putting it in a new location. Once you practice this a bit it will make much more sense (and it will speed up your code considerably).
As noted at the beginning, if you need formatting kept then that is a bit different.
Also, I didnt bother with optimizing or indenting any of the other elements of your code, but you will want to clean it up with proper indenting and skipping things like "GoTo".
call this sub a the top of you macro:
Sub MakeItFaster()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
End Sub

How to increase only last digit of a serial number string in Excel VBA?

I'm new to vba and trying to write a barcode scanner algorithm. It works fine right now but I want to keep serial numbers in my exel table and their structure has to be like "A151000". I want with each barcode entered a cell with an inputbox also be assigned to a serial number. for example when a new entry(Barcode) written in column C I want in column B serial numbers last digit increased by 1 and stored in that cell automatically.
Right now I can drag the cell from corner and exel increases the last digit. How can I trigger this with new entries automatically? Thanks in advance.
A151000
A151001
A151002
...
Sub DataInput()
Dim SearchTarget As String
Dim myRow As Long
Dim Rng As Range
Static PrevCell As Range
Dim FoundCell As Range
Dim CurCell As Range
Dim a As String
Dim Target As Range
Dim buttonclick As Boolean
V = True
If PrevCell Is Nothing Then
myRow = Selection.Row
Set PrevCell = Range("C" & myRow)
End If
Set Rng = Range("C:C,C:C") 'Columns for search defined here
With Rng
Set FoundCell = .Cells.Find(What:=SearchTarget, _
After:=PrevCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=True)
End With
Dim Eingabezahl As String
Do While Eingabezahl! = ""
Eingabezahl = InputBox("Last barcode scanned" & " " & Eingabezahl)
Range("C" & Range("C" & Rows.Count).End(xlUp).Row + 1) = Eingabezahl
Range("D" & Range("D" & Rows.Count).End(xlUp).Row + 1) = Now()
Range("E" & Range("E" & Rows.Count).End(xlUp).Row + 1) = "VALID"
Loop
End Sub
TO use the Autofill function and not change your original code you could just add in the autofill in your sub:
Dim Eingabezahl As String
Dim rngLastBCell As Range
Do While Eingabezahl = ""
Eingabezahl = InputBox("Last barcode scanned" & " " & Eingabezahl)
Set rngLastBCell = Range("B" & Rows.Count).End(xlUp)
rngLastBCell.AutoFill Destination:=Range(rngLastBCell, rngLastBCell.Offset(1)), Type:=xlFillDefault
Range("C" & Range("C" & Rows.Count).End(xlUp).Row + 1) = Eingabezahl
Range("D" & Range("D" & Rows.Count).End(xlUp).Row + 1) = Now()
Range("E" & Range("E" & Rows.Count).End(xlUp).Row + 1) = "VALID"
Loop
Or you could use the following that using the same concept (an autofill) but condenses al of your calls to the worksheet into a single line:
Dim Eingabezahl As String
Dim rngLastBCell As Range
Do While Eingabezahl = ""
Eingabezahl = InputBox("Last barcode scanned" & " " & Eingabezahl)
Set rngLastBCell = Range("B" & Rows.Count).End(xlUp)
rngLastBCell.AutoFill Destination:=Range(rngLastBCell, rngLastBCell.Offset(1)), Type:=xlFillDefault
rngLastBCell.Offset(1, 1).Resize(, 3) = Array(Eingabezahl, Now(), "VALID")
Loop
Although I would recommend just using appenending the current row to the end of your serial and not making as many calls to the worksheet by using an array:
Dim rngB As Range
Dim Eingabezahl As String
Dim SerialBase As String
SerialBase = "A15100"
Do While Eingabezahl = ""
Eingabezahl = InputBox("Last barcode scanned" & " " & Eingabezahl)
Set rngB = Range("B" & Rows.Count).End(xlUp).Offset(1)
rngB.Resize(, 4).Value = Array(SerialBase & rngB.Row, Eingabezahl, Now(), "VALID")
Loop