How to get excel VBA to format date - excel

I am making a GUI in excel that allows the user to enter information into the spreadsheet just by using the GUI. I have run into a problem however. I can't seem to get the date to format right. this is the code I have for it (it being the code for the GUI:
Dim AN As Worksheet
Set AN = ThisWorkbook.Sheets("Sheet2")
Dim n As Long
n = AN.Range("A" & Application.Rows.Count).End(xlUp).Row
'AN.Range("A" & n + 1).Value ='
AN.Range("B" & n + 1).Value = Me.yyyy.Value + "-" + Me.mm.Value + "-" + Me.dd.Value
'AN.Range("C" & n + 1).Value ='
AN.Range("D" & n + 1).Value = Me.N_O_B.Value
AN.Range("E" & n + 1).Value = Me.Address_street.Value
AN.Range("F" & n + 1).Value = Me.City_info.Value
AN.Range("G" & n + 1).Value = Me.State_info.Value
AN.Range("H" & n + 1).Value = Me.Zip_info.Value
AN.Range("I" & n + 1).Value = Me.Lname.Value
AN.Range("J" & n + 1).Value = Me.Fname.Value
AN.Range("K" & n + 1).Value = Me.Minitial.Value
AN.Range("L" & n + 1).Value = Me.Suffix.Value
AN.Range("P" & n + 1).Value = Me.Busi_zip.Value
AN.Range("X" & n + 1).Value = Me.Shrt_Descript.Value
I am trying to get the date to show up in column B. It is showing up in column B, but not the way I thought it would. So in the GUI you enter the year, the month, and the date. Then I tried to make the code take the information and put it in a YYYY/MM/DD format but its not working. I have to have it in this format. Any advice would be helpful.

Force the date's raw value and then format the cell.
AN.Range("B" & n + 1).Value = dateserial(Me.yyyy.Value, Me.mm.Value, Me.dd.Value)
AN.Range("B" & n + 1).numberformat = "yyyy-mm-dd"
btw, the correct string concatenation operator is an ampersand (e.g. &). While a plus sign may work, it is best avoided, particularly when working with numbers.

Related

SumProduct Function with Criteria from Different Locations Using VBA

Updated:
Taking into consideration community comments, I have made some changes (declarations, removed unnecessary variables) and attempted two styles to no avail.
Without criteria the code returns 400, after one line is populated.
.Cells(i, 38 + l) = Evaluate("=SUMPRODUCT(" & Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn & "," & Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn & ",--(" & Worksheets(Cells(i, 1).Value).Columns(4).EntireColumn & "=" & .Cells(i, 2).Value & "),--(" & Worksheets(Cells(i, 1).Value).Columns(5).EntireColumn & "=" & .Cells(i, 3).Value & "))")
And also:
.Cells(i, 38 + l) = Application.WorksheetFunction.SumProduct(Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn, Worksheets(Cells(i, 1).Value).Columns(83 + l * 4).EntireColumn, --(Worksheets(Cells(i, 1).Value).Columns(4).EntireColumn = .Cells(i, 2).Value), --(Worksheets(Cells(i, 1).Value).Columns(5).EntireColumn = .Cells(i, 3).Value))
/Update end.
I have been trying to code a macro, which will gather data from different worksheets of one workbook to summary sheet and perform necessary calculations ("sumifs", "sumproduct") in cycle. The same code will be used in the other workbooks with different variable parameters.
While "sumifs" is working fine, there is an issue with "sumproduct" function (I am using Application.WorksheetFunction instead of Evaluate).
The code returns Type Mismatch error. Most likely I am calling the function improperly, OR, the criteria within the function.
I am kindly asking for community support, as I feel, I have exhausted my ability to think today.
' Populate table from KA sheets for I/O to SOP Report
Dim EndRow As Long
Dim i As Long
Dim j As Long
Dim l As Long
Dim catLst As Range
Dim pglst As Range
Start:
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
EndRow = Cells(Rows.Count, 1).End(xlUp).Row
Set pglst = ThisWorkbook.Worksheets("SUMMARY").Range("$D:$D")
Set catLst = ThisWorkbook.Worksheets("SUMMARY").Range("$E:$E")
For i = 4 To EndRow
For j = 0 To 24
For l = 0 To 6
With ThisWorkbook.Worksheets("IO")
.Cells(i, 4 + j) = Application.WorksheetFunction.SumIfs(Worksheets(Cells(i, 1).Value).Columns(54 + j).EntireColumn, pglst, .Cells(i, 2).Value, catLst, .Cells(i, 3).Value)
.Cells(i, 30 + l) = Application.WorksheetFunction.SumIfs(Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn, pglst, .Cells(i, 2).Value, catLst, .Cells(i, 3).Value)
.Cells(i, 38 + l) = Application.WorksheetFunction.SumProduct(Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn, Worksheets(Cells(i, 1).Value).Columns(83 + l * 4).EntireColumn, --(Worksheets(Cells(i, 1).Value).Columns(4).EntireColumn = .Cells(i, 2).Value), --(Worksheets(Cells(i, 1).Value).Columns(5).EntireColumn = .Cells(i, 3).Value))
' .Cells(i, 38 + l) = Evaluate("=SUMPRODUCT(" & Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn & "," & Worksheets(Cells(i, 1).Value).Columns(81 + l * 4).EntireColumn & ",--(" & Worksheets(Cells(i, 1).Value).Columns(4).EntireColumn & "=" & .Cells(i, 2).Value & "),--(" & Worksheets(Cells(i, 1).Value).Columns(5).EntireColumn & "=" & .Cells(i, 3).Value & "))")
End With
Next l
Next j
Next i
'Set i = Nothing
'Set j = Nothing
'Set l = Nothing
ThisWorkbook.Worksheets("IO").Range("AS1") = "UPDATED: " & Format(Now(), "dd/mm/yyyy HH:MM")
Finish:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
First thing:
Dim catLst, pglst, condPG, condCAT As Range
only condCAT is declared as Range the rest is declared as Variant.
(Same with your long declaration)
Like BigBen wrote, it is unclear what you are doing with this evaluate.
You should not use Evaluate
Set for every part in your SumProduct a range. So that your Sumproduct would be like
Application.WorksheetFunction.SumProduct(range1,range2,...)
And look, if every range has the same size. SumProduct is a matrix function.
E.G. Range("A1:A5") Range("B1:B3") could not work in Sumproduct because of Elements
But I guess, some parts of your SumProduct are just wrong type.

Extracting the first digit from an alpha-numeric string

Is it possible to use VBA to catch and use the first number in a text string and if there is no number then just use 1?
The code I'm currently using is looking at column AC and finding a specific text then using the first two letters of that text and the right most number and replacing the corresponding row in column N.
What I'm attempting to do now is account for when there is no number in the text (should =1), or there is but it's in the mid but the location moves (thus a mid statement wouldn't work). If this is possible Any suggestions or push in the right direction would be appreciated.
Dim wsl As Worksheet
Dim LR As Long, i As Long
mydate = Format(Date, "YYMMDD")
Set wsl = LagoDLFile.Sheets("cid_SeventhAvenue_" & mydate & "")
LR = wsl.Range("AC" & wsl.Rows.Count).End(xlUp).Row
For i = 2 To LR
If wsl.Range("AC" & i) Like "*EOC*" Then
wsl.Range("N" & i) = "EOC"
ElseIf wsl.Range("N" & i) Like "700" Then
wsl.Range("N" & i) = "CHK"
ElseIf wsl.Range("AC" & i) Like "*CTOB*" Then
wsl.Range("N" & i) = "COF"
ElseIf wsl.Range("AC" & i) Like "EXOBC*" Then
wsl.Range("N" & i) = "WR" & Right(wsl.Range("AC" & i), 1)
ElseIf Left(wsl.Range("AC" & i), 3) = "OBC" Then
wsl.Range("N" & i) = "OB" & Right(wsl.Range("AC" & i), 1)
ElseIf Left(wsl.Range("AC" & i), 3) = "IFC" Then
wsl.Range("N" & i) = "IF" & Right(wsl.Range("AC" & i), 1)
ElseIf Left(wsl.Range("AC" & i), 3) = "IBC" Then
wsl.Range("N" & i) = "IB" & Right(wsl.Range("AC" & i), 1)
End If
Next i
End Sub
Here is a function that uses regular expressions to do what you need. It uses this regex:
^\D*(\d)
Breaking down the pattern
^ Start of string
\D* Any character that is not a digit (capital D), with a * quantifier that means 0 or more times
(...) Capturing group - it will capture the text that you want to keep and return it as a submatch
\d any numerical value (0-9).
Note: If you want it to capture more than the first digit (such as string123 - you want to return 123, you can change (\d) in the above regex to (\d+). The + is a quantifier that means one or more of \d.
See this regex work at Regex101. The green highlighted portion is what would be returned from the below function.
Creating the function / UDF
Public Function getFirstDigit(testString As String) As String ' or As long
With CreateObject("VBScript.RegExp")
.Pattern = "^\D*(\d)"
.Global = False
If .test(testString) Then
getFirstDigit = .Execute(testString)(0).SubMatches(0)
Else
getFirstDigit = "1"
End If
End With
End Function
You can use this function within both VBA and as a worksheet function.
Using in VBA:
Msgbox getFirstDigit("Test String 123")
Using in the worksheet
=getFirstDigit($A$1)
Variant without RegExp
Public Function firstIntInString(testStr As String) As Integer
Dim x%
For x = 1 To Len(testStr)
If Mid(testStr, x, 1) Like "#" Then
firstIntInString = Mid(testStr, x, 1)
Exit For
Else
firstIntInString = 1 'in case when string doesn't contains digits
End If
Next x
End Function

Excel VBA add parameters to Max range

I have the following VBA which is working fine
Worksheets(d).Cells(x, 5).Value = Application.WorksheetFunction.Max(Range("Data!E3:E7"))
This method should be nested in a FOR function such as
For i = 3 To j
Worksheets(d).Cells(x, 5).Value = Application.WorksheetFunction.Max(Range("Data!E3:E5"))
x = x + 1
Next
How can I parse the E3 and E7to be parameter based according to i meaning
E3 = "E" + i
E5 = "E" + i + 2
full example of what I'm trying:
For i = 3 To j
Worksheets(d).Cells(x, 5).Value = Application.WorksheetFunction.Max(Range("Data!E" + i + ":E" + i+2 +"))
x = x + 1
Next
Try
Sheets("Data").Range("E" & i & ":E" & (i + 2))
& is better than + in combining data of various types into a string. Also -- Range is a child of WorkSheet -- so you need to go through the appropriate Sheet object
Note that you can do this directly without a loop
As formula
Worksheets(d).Cells(x, 5).Resize(J - 3 + 1, 1).FormulaR1C1 = "=MAX(Data!R[1]C5:R[" & J - 3 + 1 & "]C5)"
As values
Worksheets(d).Cells(x, 5).Resize(J - 3 + 1, 1).Value = "=MAX(Data!R[1]C5:R[" & J - 3 + 1 & "]C5)"

Sorting through large ugly file

I have an excel document that is, and looks physically like a report. I only need some of the data. What is the best of coming up with a formula that gets me this information. Document has 88 entries.
You can click the image for a full-size version:
I want to come up with a search that returns the stuff in yellow. Any idea how to get that done? Or is this a manual search type of deal? I'm asking, not because I want to save 3 hours on doing this, but because I would like to save time in the future. Thanks!
As long as your template is in the same format, the below code should work. I tried to keep it as simple as possible so you can see what the individual steps do. You an adjust the columns where the data is pasted to suit. You will need to first create a sheet called 'Extract' and change any occurrence of 'YourSheetNameHere' within the code.
Sub Extract()
Dim Page, Company, Num, Name, ProjMan, TotalVal, Fee As String
Dim r, c As Integer
c = 1
Sheets("YourSheetNameHere").Select
For r = 1 To 4680
If Left(Range("J" & r).Value, 4) = "Page" Then
'Stores the values
Page = Range("J" & r)
ProjMan = Range("J" & r + 2)
TotalVal = Range("J" & r + 4)
Company = Range("J" & r + 4)
Num = Range("J" & r + 6)
Name = Range("J" & r + 7)
Fee = Range("H" & r + 31)
'Pastes the values in a new sheet called Extract (which you will need to create first)
Sheets("Extract").Select
Range("A" & c) = Page
Range("B" & c) = ProjMan
Range("C" & c) = TotalVal
Range("D" & c) = Company
Range("E" & c) = Num
Range("F" & c) = Name
Range("G" & c) = Fee
c = c + 1
Sheets("YourSheetNameHere").Select 'You will need to adjust to suit
End If
Next r
End Sub

VBA macro copies wrong data to cell

This is what I am trying to do:
If J contains the word Defendant
And
If F contains the word Foreclosure
Then
If G contains " V ESTATE OF "
Then keep everything to the right of "OF"
Else If G contains " VS "
Then keep everything to the right of " VS "
Else If G contains " V " (notice the spaces before and after V)
Then keep everything to the right of " V "
If K contains " " (two consecutive spaces)
Then Keep it
Or
If K contains "UNKNOWN SPOUSE OF"
Then remove the very last character of cell, which will be a comma
And if the cell begins with an underscore
Then remove it
Then Keep it
Assign the result of G to the corresponding N cell
Assign the result of K to the corresponding O cell
This is what I did:
Sub Inspect()
Dim RENums As Object
Dim RENums2 As Object
Dim LValue As String
Dim LValue2 As String
Set RENums = CreateObject("VBScript.RegExp")
Set RENums2 = CreateObject("VBScript.RegExp")
RENums.Pattern = "DEFENDANT"
RENums2.Pattern = "FORECLOSURE"
Dim lngLastRow As Long
lngLastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Dim i
For i = 1 To lngLastRow
If RENums2.test(Range("F" & i).Value) Then
If RENums.test(Range("J" & i).Value) Then
pos = InStr(Range("G" & i), " V ")
pos2 = InStr(Range("G" & i), " VS ")
pos3 = InStr(Range("G" & i), " V ESTATE OF ")
dbspace = InStr(Range("K" & i), " ")
If pos3 <> 0 Then
LValue2 = Right(Range("G" & i), Len(Range("G" & i)) - pos * 2)
ElseIf pos <> 0 Then
LValue2 = Right(Range("G" & i), Len(Range("G" & i)) - pos - 2)
ElseIf pos2 <> 0 Then
LValue2 = Right(Range("G" & i), Len(Range("G" & i)) - pos - 2)
End If
If dbspace <> 0 Then
LValue = Range("K" & i)
End If
schr = Right(LValue, 1)
If schr = "_" Then
With WorksheetFunction
Range("N" & i).Value = Trim(.Substitute(LValue, "_", ""))
End With
Else
Range("N" & i).Value = Trim(LValue)
End If
Range("O" & i).Value = Trim(LValue2)
End If
End If
Next i
End Sub
With the above macro, the correct value is never pasted into N in some cases. Rather a value from another cell in K is pasted to the wrong cell in N.
I attached an example of excel spreadsheet on the below link to which I never received a response:
http://www.excelforum.com/excel-programming/775695-wrong-data-copied-into-new-cell-from-macro.html
Thanks for response.
Your LValue and LValue2 variables are being populated conditionally (ie, not each time through the loop), but your final block is executed EVERY TIME, so it stands to reason that some times through the loop, you are using an old value of LValue or LValue2 (or both).
You need to clear them out at the beginning of the loop, or else have an ELSE clause in both your LValue and LValue2 IF blocks that takes care of that scenario.
Edit based on your comment: I prefer using MID() to RIGHT() in this scenario, makes it much easier to get the math right, since we're counting from the left (which is the value that InStr() returns):
cellText = Range("K" & i).Value
LValue = Mid(cellText, Unknown + 18, 100)
A few additional notes:
You use it so many times, put the tested value into a variable like I did above. It might even be marginally faster that way instead of going back to the worksheet each time.
I prefer to use Cells(11, i).Value to Range("K" & i).Value. Works the same, but much easier to use with variable row or column numbers.
It usually works the way you've done it, but make sure to use the correct property of the range object (Range().Value or Range().Formula or whatever) instead of just relying on the "default property" to always be correct.
When checking for the underscore, you are testing if the last character is an underscore. Your question states that you want to test if the value begins with an underscore.
schr = Right(LValue, 1)
If schr = "_" Then
Try
schr = Left(LValue, 1)
If schr = "_" Then

Resources