I have a 2D array and have to print parts of it to a sheet,
when I do print it to a sheet most dates appear exactly as they do in the locals window.
Some of them don't instead appearing as US Date
Sub ConvertDates()
With Range("G1:G76")
.NumberFormat = "dd/mm/yyyy"
.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False,
_
Semicolon:=False, Comma:=False, Space:=False, Other:=False,
FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
End With
End Sub
If I change the format inside of excel it just rearranges the date into the UK format but the date is wrong.
EG 11/06/2019 is transposed from the array as 06/11/2019
but 13/06/2019 is transposed from the array as 13/06/2019 as it should be.
Reformatting the cell inside excel has zero effect, it just changes the format
of the date it already decides is correct in the US format.
IF i run VBA code to change the format, it accepts the reformat and now displays the correct date. WTF?? See Convertdates()
BUT, if I alter the convertdates() code to numberformat = "dd/mm/yyyy"
it will display the incorrect date??
if you need the array code I can show it, but this is bizarre.
the dates this anomaly occurs with are 10,11,12 out of a possible range of
10,11,12,13,14,15,16
Yes I know your frustration with this. The workaround I found is below. I stored dates from a range to my array iArray. When outputing them to a specified range use the below.
Sheet1.Cells(myRow, myCol).Value = Format$(iArray(aRow, aCol), "\ dd\/mm\/yyyy\")
Additionally you would need to run an adaptation of the below to clean after. The above will keep a space in the front of the date and for some reason when you run VBA on that date it changes back to US.
Sub CleanDates()
'excel converting uk dates to us after performing action on it with VBA
Dim strDate As String, strTrim As String
Dim dRng As Range, dCol As Long, lRow As Long
Dim i As Long, j As Long
Set dRng = wsU.Rows(1).Find(What:="Start Dates", LookAt:=xlWhole)
If Not dRng Is Nothing Then
dCol = dRng.Column
Else
MsgBox "Failed to find the date columns to clean dates. Please consult the developer.", vbCritical
Exit Sub
End If
lRow = wsU.UsedRange.Rows.Count
For i = 2 To lRow
For j = dCol To (dCol + 1)
strDate = wsU.Cells(i, j).Text
strTrim = Right(strDate, Len(strDate) - 1)
wsU.Cells(i, j).Value = DateSerial(Year(strTrim), Month(strTrim), Day(strTrim))
Next j
Next i
End Sub
Hope it helps with your issue.
Related
I have a code written that makes an array from a specific range in my worksheet
Dim LastColumn As Long
LastColumn = Cells(Cells.Find("Parameters", lookat:=xlWhole).Row, Columns.Count).End(xlToLeft).Column
Dim PackageDepthMax
PackageDepthMax = ThisWorkbook.Worksheets("Machine Specification").Range(Cells(Cells.Find("Package Depth(mm)").Row, 3), Cells(Cells.Find("Package Depth(mm)").Row, LastColumn)).Value
Which takes all the values from my range which could look like:
What I am trying to do now is to have my "PackageDepthMax" consist of only the second integers in the value aka (100 , 110 , 120) instead of (1-100 , 1-110 ,1-120).
My attempt didn't do what I expect so I'm kinda lost
Dim LastColumn As Long
LastColumn = Cells(Cells.Find("Parameters", lookat:=xlWhole).Row, Columns.Count).End(xlToLeft).Column
Dim PackageDepthMax
PackageDepthMax = Split(ThisWorkbook.Worksheets("Machine Specification").Range(Cells(Cells.Find("Package Depth(mm)").Row, 3), Cells(Cells.Find("Package Depth(mm)").Row, LastColumn)).Value, " - ")(1)
What's the mistake I'm making and how do I achieve the goal I'm looking for?
Keep in mind, excel will not allow split multiple columns (range of columns) at the same time.
what about replacing unwanted symbols with "" ...
For example:
yourRange.Replace What:=" ", Replacement:="" to remove any gaps which may popout in wrong amounts
yourRange.Replace What:="1-", Replacement:="" removing leading "1-" from the beginning of the value
or simply yourRange.Replace "1 - ", ""
I have a simple macro that includes a dynamic array which fills up upon conditions are met. The data populates the macro as it is supposed to be functioning until it paste the data onto the spreadsheet. Now, all data is pasted correctly except for date values. Date values are pasted erroneously from European format to American format onto the spreadsheet (i.e. dd-mm-yyyy to mm-dd-yyyy). So for instance a 1st march 2019 becomes a 3rd January 2019 on the spreadsheet. Note that either I format beforehand the destination files or not, the problem still occurs.
The array has 14 columns and only column 12-13 are date values.
Edit Summary
Shredded the code from irrelevant information; added images of results.
Following is the code
Sub Verification()
Dim NewWorkbook As String, NewWorksheet As String
Dim wb As Workbook, sh As Worksheet
Dim LoopCounter As Long
Dim NewEntryCounter As Long
Dim Cols As Long, Rows As Long
Dim r As Range
Dim arr As Variant, NewEntry() As Variant
Dim myRange As Integer
NewWorkbook = LCase(InputBox("What is the name of the new report?"))
NewWorksheet = LCase(InputBox("What is the name of the sheet?"))
Set wb = ThisWorkbook
Set sh = wb.Sheets("Renouvellement")
Cols = Workbooks(NewWorkbook).Sheets(NewWorksheet).Range(Workbooks(NewWorkbook).Sheets(NewWorksheet).Cells(1, 1), Workbooks(NewWorkbook).Sheets(NewWorksheet).Cells(1, 1).End(xlToRight)).Count
Rows = sh.Range(sh.Cells(1, 1), sh.Cells(1, 1).End(xlDown)).Count
For Each r In Workbooks(NewWorkbook).Sheets(NewWorksheet).Range("A2", Workbooks(NewWorkbook).Sheets(NewWorksheet).Range("A1").End(xlDown))
If (r.Offset(0, 21).Text = "Red" Or r.Offset(0, 21).Text = "Blue") And r.Offset(0, 17).Value >= 24 Then
arr = Application.VLookup(r.Value, sh.Range("A:A"), 1, 0)
If IsError(arr) Then
NewEntryCounter = NewEntryCounter + 1
ReDim Preserve NewEntry(1 To Cols, 1 To NewEntryCounter)
For LoopCounter = 1 To Cols
NewEntry(LoopCounter, NewEntryCounter) = r.Offset(0, LoopCounter - 1)
Next LoopCounter
Else
End Sub
Sample results from Local window
Sample results when transferring date values onto spreadsheet
As you can see the first value inserted is changed when transferring data from vba to spreadsheet. The second value is correctly transferred. The third is not, and so on.
Again, it's a bit difficult for me to understand exactly what you're doing, but it seems that a filter might be simpler, so far as the copying of relevant data is concerned.
In your code, you are making multiple calls to the worksheet, and multiple Redim Preserve operations on the VBA array. Those operations can be costly.
Perhaps that part of the code could be simplified (and sped up) with something like (obviously, you may need to change the worksheet and range variables):
Set ws = Worksheets("sheet1")
Set r = ws.Range("a1").CurrentRegion
With r
.AutoFilter field:=22, Criteria1:="red", Operator:=xlOr, Criteria2:="blue"
.AutoFilter field:=18, Criteria1:=">=24"
End With
r.SpecialCells(xlCellTypeVisible).Copy
'Paste somewhere
ws.ShowAllData
I have three sheets called: "Dane magazyn", "Sheet3" and "Dostawcy".
What I want my Excel to do is:
1) filter out #N/A values in col. J on sheet "Dane magazyn". All values that should stay after filtering are stored in Col. E on sheet "Dostawcy" - 21 entries, but it will be more in the future.
2) select data that remained after filtering and copy to "Sheet3"
Here's my code so far:
Sub filtruj()
Dim i As Long, arr As Variant, LastRow As Long
Sheets("Dostawcy").Select
With ActiveSheet
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
End With
arr = Sheets("Dostawcy").Range("E2:E" & LastRow).Value
Sheets("Dane magazyn").Select
With ActiveSheet
**.Columns("J").AutoFilter Field:=1, Criteria1:=arr, Operator:=xlFilterValues** <---- here I get error
End With
Rest of code...
Error message I get is:
"Run-time error '1004':
AutoFilter method of Range class failed"
websites I've checked (not all listed)
Using string array as criteria in VBA autofilter
VBA assign a range to an Array from different sheet
Fastest way to read a column of numbers into an array
Thanks in advance
Here is working code:
Dim rng, rngToFilter As Range
Dim i As Integer: i = 1
'set you range to area with values to compare against
'if you can, specify here exact range instead of whole column, it can increase efficiency
Set rng = Sheets("Dostawcy").Range("E:E")
'set range to be filtered out, don't specify here whole column,
'in following loop it can result in overflow error
Set rngToFilter = Sheets("Dane magazyn").Range("J1:J100")
'here we will iterate through all cells within the searched range,
'for every cell we will try to find it's value within the other range,
'if it succeeds, so it's not Nothing, then we copy it to Sheet3
For Each cell In rngToFilter
'if any cell causes the error, we will skip one iteration
On Error GoTo ErrorHandler:
If Not rng.Find(cell.Value) Is Nothing Then
Sheets("Sheet3").Cells(i, 1).Value = cell.Value
i = i + 1
End If
ErrorHandler:
Next cell
Don't use Select unless you must, it reduces efficiency of a program.
I search a good way to check if one date is present into one array.
I'm able to chech if a string is in to an array but I can't modify the cose to use it with date.
Dim datatest as date
Dim arfest As Variant
UR = Sheets("Fest").Cells(Rows.Count, 1).End(xlUp).Row
arfest = Sheets("Fest").Range("A2:A" & UR) 'A2=1/1/2015,A3=5/2/2015,A4=8/5/2015,.....
datatest= 5/2/2015
if instr(1, datatest, arfest,1) then ..
result: Error run-time '13', type not corresponding
what wrong?!?!
3 points here:
When you read worksheet cells into a variant, if you don't specify the property (ie Text, Value or Value2), the default is .Value. This is always a bit risky with dates as you can't be sure about date formats. I find it easier to work with Excel's date values (which are Long and therefore not susceptible to formatting problems). You might therefore be better off specifying .Value2.
The variant array needs to be interrogated in a loop, ie checking each element of the array. So your Instr function won't work, as this checks a String.
If you decide to compare date values instead of the strings or dates themselves, the use DateValue() to convert a date to its Excel value and CDate to convert the value to a date.
You might consider rewriting your code as follows:
Dim datetest As Long
Dim arfest As Variant
Dim UR As Range
Dim i As Long
' Read the values into the variant array
With ThisWorkbook.Worksheets("Fest")
Set UR = .Cells(.Rows.Count, "A").End(xlUp)
arfest = .Range("A1", UR).Value2
End With
datetest = DateValue(DateSerial(Year:=2015, Month:=2, Day:=5))
'Loop through the array, checking each date value
For i = 1 To UBound(arfest, 1)
If arfest(i, 1) = datetest Then
MsgBox DateValue(CDate(arfest(i, 1)))
End If
Next
I've changed way with a loop, if I find the date into array, I add one day..
For Each i In arfest
If datatest = i Then datatest= DateAdd("d", 1, datatest)
Next i
forgive the hasty ask
So I have found and modified a macro that fits my needs, however there is one limitation. I am building a macro to search medical payment data for specific diagnosis codes and procedure codes. In the project I am currently working on there are only 14 diagnosis codes, so I was able to put this directly into the VBA. However, there are over 800 procedure codes which I cannot fit into the VBA.
I was able to do a seperate VBA step to bring in a table with this data, but I cant seem to get it set up to search against the table. But that being said, what is the best way to run this VBA search for such a large number of items?
Sub PROCEDURE_1_search()
Dim FirstAddress As String
Dim MySearch As Variant
Dim myColor As Variant
Dim Rng As range
Dim I As Long
MySearch = Array("412", "4100", "4101", "4102", "4103",...) <-- have over 800
With Sheets("All Claims by Date of Service").range("G5:G55000")
For I = LBound(MySearch) To UBound(MySearch)
Set Rng = .Find(What:=MySearch(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
With ActiveSheet.range("B" & Rng.Row & ":O" & Rng.Row)
.Font.ColorIndex = 1
.Interior.ColorIndex = 4
End With
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
End If
Next I
End With
End Sub
I might be coming up with an answer and not asking the right questions. Please let me know if there is anything I can clarify and thank you in advance for any assistance.
-Ryan
For searching an array, I would recommend you to dump the data into a variant Array instead of iterating through ranges. That way it reduces the traffic of going back on forth on the code and sheet - specially formatting. Formatting is anyway expensive, in your case it seems to cost you a moon..
So here is how it goes by steps: (not the code - if you need a code take a look at these samples.).
Transpose the data into a variant array
Search as you desire in VBA code
Dump the databack in the location (range)
Format (range)
In your example you could use AutoFilter like this to highlight rows from columns B to O where G falls between 4101-4103 in a single shot (ie four criteria match a single conditon). A minor adaption would be to call this code block for different criteria such as a standaline 412 etc.
Sub Smaller()
Dim rng1 As Range
Set rng1 = Sheets("All Claims by Date of Service").Range("$G$5:$G$55000")
With rng1
.AutoFilter Field:=1, Criteria1:=">=4100", Operator:=xlAnd, Criteria2:="<=4103"
.Offset(0, -6).Resize(rng1.Rows.Count, 14).Font.ColorIndex = 1
.Offset(0, -6).Resize(rng1.Rows.Count, 14).Interior.ColorIndex = 4
End With
Sheets(rng1.Parent.Name).AutoFilterMode = False
End Sub