there I have an excel VBA code that retrieves its records from an external file by month and set it according to the column heading.
However, i have an error in of application-defined or object-defined error in of the line .Range("A6").Resize(n, 23) = b
does anyone know why
code:
Sub zz()
Dim arr, c, b(), n&
Application.ScreenUpdating = False
Worksheets("Sheet2").Range("A6").AutoFilter
Workbooks.Open "C:\Users\sophia.tan\Desktop\MasterPlanData.xlsx", 0, 1
arr = Sheets("Excel").UsedRange
ActiveWorkbook.Close 0
c = Array(0, 2, 13, 14, 7, 8, 11, 1, 9, 10, 16, 17, 20, 22, 15, 30, 27, 28, 29, 3, 4, 30)
d = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23)
ReDim b(1 To UBound(arr), 1 To 23)
For i = 2 To UBound(arr)
If arr(i, 12) >= DateSerial(Year:=2017, Month:=11, Day:=1) And arr(i, 12) <= DateSerial(Year:=2017, Month:=11, Day:=31) Then
n = n + 1
For j = 1 To UBound(c)
b(n, d(j)) = arr(i, c(j))
Next
End If
Next
With Worksheets("Sheet2")
.Range("A6:T" & Rows.Count).CurrentRegion.AutoFilter field:=1, Criteria1:="<>OFM"
.Range("A6:T" & Rows.Count).CurrentRegion.SpecialCells(xlCellTypeVisible).AutoFilter field:=13, Criteria1:="<>Collar & Cuff"
.Range("A6:T" & Rows.Count).CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Range("A6").Resize(n, 23) = b
.Range("A6").CurrentRegion.Sort key1:=Range("G6"), order1:=xlAscending, Header:=xlYes
.Range("A6").Select
End With
Application.ScreenUpdating = 1
End Sub
Your determination on n is subjective to the If statement. However, any unfilled values in the 'rows' of b will be vbnullstrings and will produce truly blank cells.
.Range("A6").Resize(ubound(b, 1), ubound(b, 2)) = b
Alternately,
For i = 2 To UBound(arr)
If arr(i, 12) >= DateSerial(Year:=2017, Month:=11, Day:=1) And arr(i, 12) <= DateSerial(Year:=2017, Month:=11, Day:=31) Then
n = n + 1
For j = 1 To UBound(c)
b(n, d(j)) = arr(i, c(j))
Next
End If
Next
b = application.transpose(b)
redim preserve b(lbound(b, 1) to ubound(b, 1), lbound(b, 2) to n)
b = application.transpose(b)
.Range("A6").Resize(n, 23) = b
You can only adjust the last rank of an array with ReDim when using the preserve parameter.
Try
.Range("A6").Resize(n, 23).Value = b
Related
I have a spreadsheet like this, and I would like to have a function that returns the list of row numbers non-empty cells in column B. In this case, it should return "2, 3, 4, 5, 8, 9, 10, 11, 12, 13, 14, 15, 16, 18, 20, 21, 22, 23, 25, 26)
How do I do this in VBA?
Function GetEmptyCount()
Dim arr(), x&, cell
With Range("B1:B" & Cells(Rows.Count - 1, "B").End(xlUp).Row)
For Each cell In .SpecialCells(xlCellTypeBlanks).Cells
x = x + 1
ReDim Preserve arr(1 To x)
arr(x) = cell.Row
Next
End With
GetEmptyCount = arr
End Function
Sub Test()
Dim x, c
x = GetEmptyCount()
For Each c In x: MsgBox c: Next
End Sub
You can check the length of the cell value something like
IF(Length(Cell) > 0 THEN
// Include the row
ELSE
// skip the row
I have an Excel VBA code that retrieves data from an external workbook into a worksheet by month.
I would like to retrieve the month of November but I can't seem to type the date to be #30/11/2017#. The date would automatically change to #11/30/2017#.
The date has to be in dd/mm/yyyy as that is the format of date in the external workbook.
Sub zz()
Dim arr, c, b(), n&
Application.ScreenUpdating = False
Worksheets("Sheet2").Range("A6").AutoFilter
Workbooks.Open "C:\Users\sophia.tan\Desktop\excel masterplan\External
workbook.xlsx", 0, 1
arr = Sheets("MaximMainTable").UsedRange
ActiveWorkbook.Close 0
c = Array(0, 2, 12, 13, 6, 7, 10, 1, 8, 9, 15, 16, 18, 19, 14, 27, 24, 25,
26, 3, 4, 36)
d = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19,
20, 21, 23)
ReDim b(1 To UBound(arr), 1 To 23)
Selection.NumberFormat = "dd/mm/yyyy"
For i = 2 To UBound(arr)
If arr(i, 12) >= (#1/11/2017#) And arr(i, 12) <= Format(#11/30/2017#) Then
n = n + 1
For j = 1 To UBound(c)
b(n, d(j)) = arr(i, c(j))
Next
End If
Next
Dim startRow As Long, lastRow2 As Long
startRow = 6
lastRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
For i = startRow To lastRow
If Range("A" & i) Like "MX*" Then
If Range("J" & i) Like "*Rib*" Then
Range("M" & i) = "Rib"
ElseIf Range("J" & i) Like "*Spandex*Pique*" Then
Range("M" & i) = "Spandex Pique"
ElseIf ("J" & i) Like "*Pique*" Then
Range("M" & i) = "Pique"
ElseIf ("J" & i) Like "*Spandex*Jersey*" Then
Range("M" & i) = "Spandex Jersey"
ElseIf Range("J" & i) Like "*Jersey*" Then
Range("M" & i) = "Jersey"
ElseIf ("J" & i) Like "*Interlock*" Then
Range("M" & i) = "Interlock"
ElseIf ("J" & i) Like "*French*Terry*" Then
Range("M" & i) = "Fleece"
ElseIf ("J" & i) Like "*Fleece*" Then
Range("M" & i) = "Fleece"
Else
Range("M" & i) = "Collar & Cuff"
End If
End If
Next
With Worksheets("Sheet2")
.Range("A6:T" & Rows.Count).CurrentRegion.AutoFilter field:=1, Criteria1:="
<>OFM"
.Range("A6:T" &
Rows.Count).CurrentRegion.SpecialCells(xlCellTypeVisible).AutoFilter
field:=13, Criteria1:="<>Collar & Cuff"
.Range("A6:T" & Rows.Count).CurrentRegion.Offset(1,
0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Range("A6").Resize(n, 23) = b
.Range("A5").CurrentRegion.Sort key1:=Range("G5"), order1:=xlAscending,
Header:=xlYes
End With
Application.ScreenUpdating = 1
End Sub
When you use #date# notation directly, VBA expects it in mm/DD/yyyy format.
To test if a date on your worksheet is in the month of November 2017:
If arr(i, 12) >= #11/1/2017# And arr(i, 12) <= #11/30/2017# Then
'do whatever
End If
So long as the dates in Excel are "real dates", the format of the date in the worksheet cell is irrelevant.
If the dates in Excel are text, you will need to convert them to real dates before you do the comparison. Whether you do that on the worksheet, or in your code, is irrelevant.
For the date literal in your code, you can substitute other variables that resolve to a VBA Date data type. Note that if you convert a String, the String must be in an unambiguous format (one that can only be interpreted one way).
DateSerial(2017, 11, 1)
CDate("2017-11-01")
CDate("1 Nov 2017")
I can't figure out what is the mistake I am making in this code. The error is on setting up the range (line 3 on last loop). Any help would be appreciated. I have lots of code here but i believe all of it is good except in the last loop around p it gives me an error about the range function I believe.
For p = 1 To 100
If ActiveWorkbook.Worksheets(1).Cells(p + 26, 10).Value = Sheet3.Cells(6 + k, 4).Value Then
Set rng = Sheet3.Range(Cells(k + 6, 5), Cells(k + 6, 12))
lAnswer = Application.WorksheetFunction.Sum(rng)
ActiveWorkbook.Worksheets(1).Cells(p + 27, 13).Value = lAnswer
k = k + 1
End If
Next p
End If
Next t
End Sub
You must qualify both Range and Cells with the worksheet:
Set rng = Sheet3.Range(Sheet3.Cells(k + 6, 5), Sheet3.Cells(k + 6, 12))
I consulted you guys yesterday with a very vague question. I have now managed to isolate the problem, but obviously not solved it as I am writing here.
The problem for me is to assign a variable the value/content of matrix (or variant of variant). Not sure if this is redundant, but I want to have something like the following in my spreadsheet:
A B C D E F
1 a b c d
2 e f g h
3 aa bb cc dd
4 ee ff gg hh
Here is the code:
Public Sub Test()
Dim sub_data As Variant
Dim sheet_name As String
Dim str As String
Dim rng As Range
sheet_name = "Sheet1"
Set rng = Sheets(sheet_name).Range("A1")
Worksheets(sheet_name).Cells.ClearContents
On Error Resume Next
str = "A" & CStr(print_row)
ReDim sub_data(0 To 1, 0 To 1, 0 To 3)
sub_data(0, 0, 0) = "a"
sub_data(0, 0, 1) = "b"
sub_data(0, 0, 2) = "c"
sub_data(0, 0, 3) = "d"
sub_data(0, 1, 0) = "e"
sub_data(0, 1, 1) = "f"
sub_data(0, 1, 2) = "g"
sub_data(0, 1, 3) = "h"
sub_data(1, 0, 0) = "aa"
sub_data(1, 0, 1) = "bb"
sub_data(1, 0, 2) = "cc"
sub_data(1, 0, 3) = "dd"
sub_data(1, 1, 0) = "ee"
sub_data(1, 1, 1) = "ff"
sub_data(1, 1, 2) = "gg"
sub_data(1, 1, 3) = "hh"
Call PrintArray(sub_data, str)
End Sub
Public Sub PrintArray(Data As Variant, Cl As String)
Dim ubnd_1, ubnd_2 As Integer
Dim sub_data As Variant
ubnd_1 = UBound(Data, 2)
ubnd_2 = UBound(Data, 3)
sub_data = Data(0) 'THIS LINE WON'T WORK. HOW TO ASSIGN CORRECTLY?
'here I want to print the content of the Data-variable onto the sheet
Range(Cl).Resize(ubnd_2 + 1, ubnd_1 + 1) = Application.Transpose(sub_data)
End Sub
You do not need a 3D array. I have changed your 3D to a 2D as two dimensions are all you need for your example. Spreadsheet is 2D anyways so transposing a 3D array just sounds impossible.
The easiest way
Public Sub PrintArray(Data As Variant)
Range("A10").Resize(UBound(Data, 1), UBound(Data, 2)) = Data
End Sub
but you have to make sure you change the dimensions of your matrix/array
Option Explicit
Public Sub Test()
Sheets(1).Cells.ClearContents
ReDim sub_data(1 To 4, 1 To 4)
sub_data(1, 1) = "a"
sub_data(1, 2) = "b"
sub_data(1, 3) = "c"
sub_data(1, 4) = "d"
sub_data(2, 1) = "e"
sub_data(2, 2) = "f"
sub_data(2, 3) = "g"
sub_data(2, 4) = "h"
sub_data(3, 1) = "aa"
sub_data(3, 2) = "bb"
sub_data(3, 3) = "cc"
sub_data(3, 4) = "dd"
sub_data(4, 1) = "ee"
sub_data(4, 2) = "ff"
sub_data(4, 3) = "gg"
sub_data(4, 4) = "hh"
Call PrintArray(sub_data)
End Sub
Public Sub PrintArray(Data As Variant)
Range("A1:A" & UBound(Data, 2)) = WorksheetFunction.Transpose(WorksheetFunction.Index(Data, 1, 0))
Range("B1:B" & UBound(Data, 2)) = WorksheetFunction.Transpose(WorksheetFunction.Index(Data, 2, 0))
Range("C1:C" & UBound(Data, 2)) = WorksheetFunction.Transpose(WorksheetFunction.Index(Data, 3, 0))
Range("D1:D" & UBound(Data, 2)) = WorksheetFunction.Transpose(WorksheetFunction.Index(Data, 4, 0))
End Sub
So I have changed your sub_data to a 2D variant. The structure remains the same as you expected it to be.
i have a code that has a command button which retrieves its records from an external file.
every time the command button is clicked it will delete all the records and paste again. however it allows the user input for records with "OFM","KH" and "Collar & Cuff" hence it would not delete these rows.
But, my autofilter code is not working properly as it still deletes the rows with "OFM" and "KH""
Rows.Count).CurrentRegion.SpecialCells(xlCellTypeVisible).AutoFilter
field:=1, Criteria1:="<>OFM", Operator:=xlOr, Criteria2:="<>KH"
the code:
Sub July()
Dim arr, c, b(), n&
Application.ScreenUpdating = False
Worksheets("July 2018").Range("A4").AutoFilter
Workbooks.Open "C:\Users\sophia.tan\Desktop\MasterPlanData.xlsx", 0, 1
arr = Sheets("Excel").UsedRange
ActiveWorkbook.Close 0
c = Array(0, 2, 13, 14, 7, 8, 11, 1, 9, 10, 16, 17, 20, 22, 15, 30, 27, 28,
29, 3, 4, 39)
d = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 14, 15, 16, 17, 18, 19,
20, 21, 23)
ReDim b(1 To UBound(arr), 1 To 23)
For i = 2 To UBound(arr)
If arr(i, 13) >= DateSerial(Year:=2018, Month:=7, Day:=1) And arr(i, 12) <=
DateSerial(Year:=2018, Month:=7, Day:=31) Then
n = n + 1
For j = 1 To UBound(c)
b(n, d(j)) = arr(i, c(j))
Next
End If
Next
With Worksheets("July 2018")
.Range("A4:W" &
Rows.Count).CurrentRegion.SpecialCells(xlCellTypeVisible).AutoFilter
field:=13, Criteria1:="<>Collar & Cuff"
.Range("A4:W" &
Rows.Count).CurrentRegion.SpecialCells(xlCellTypeVisible).AutoFilter
field:=1, Criteria1:="<>OFM", Operator:=xlOr, Criteria2:="<>KH"
.Range("A4:W" & Rows.Count).CurrentRegion.Offset(1,
0).SpecialCells(xlCellTypeVisible).ClearContents
.Range("A4:W" & Rows.Count).Resize(UBound(b, 1), UBound(b, 2)) = b
.AutoFilter.ShowAllData
.Range("A4").CurrentRegion.Sort key1:=Range("G3"), order1:=xlAscending,
Header:=xlYes
.Range("A4").Select
End With
Call Fabrication
Application.ScreenUpdating = 1
End Sub
Your two-criteria-for-one-field AutoFilter logic is flawed. When something is not KH it can be OFM and when something is not OFM it can be KH. I believe you want to filter for not KH and not OFM.
tldr;
You need xlAnd, not xlOr.
'...
With Worksheets("July 2018")
If .AutoFilterMode Then .AutoFilterMode = False
With .Range("A4").CurrentRegion
.AutoFilter Field:=13, Criteria1:="<>Collar & Cuff"
.AutoFilter Field:=1, Criteria1:="<>OFM", Operator:=xlAnd, Criteria2:="<>KH" '<~~ THIS RIGHT HERE
With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.SpecialCells(xlCellTypeVisible).ClearContents
End If
End With
.Cells.Sort key1:=.Columns("G"), Order1:=xlAscending, Header:=xlYes
End With
'...
.AutoFilter.ShowAllData
.Range("A4").Select
End With