PDA

View Full Version : How to use Redim



idnoidno
05-31-2017, 02:39 AM
Will the use of instr, how to edit brr and find out(filter) all the data ?

19349

mdmackillop
05-31-2017, 05:21 AM
I'm guessing a bit as to your code intention.
You can only redim the second dimension of an array. In the attached, a 23 x 4 area is used to populate a 4 x 23 array. This is re-dimmed to 4 x 6 or whatever and transposed to give a 6 x 4 result.
Note that this is not the method I would use to carry out this task.

idnoidno
06-01-2017, 06:28 AM
Hey, why do you re-dimmed to 4 x 6 array and transposed to 6 x 4 result? Use directly 6 x 4 is wrong?This is what I still do not understand the transposed method.

mdmackillop
06-01-2017, 06:42 AM
You cannot directly redim 23 x 4 to 6 x 4. You need to populate the array in a manner which allows the redimming. You therefor put values from a 23 x 4 range into a maximum 4 x 23 array, resize it and then transpose.

idnoidno
06-01-2017, 10:53 PM
Why do you use "ReDim brr(LC, LR)" instead "ReDim brr(LR, LC)"?

mdmackillop
06-01-2017, 11:27 PM
So I can later ReDim Preserve brr(LC, j)

idnoidno
06-02-2017, 12:54 AM
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column

ReDim brr(LC, LR)
Set rg = Range(Cells(1, 1), Cells(LR, LC))
arr = rg
For i = StartRow To UBound(arr)
If InStr(arr(i, Col), Txt) > 0 Then
j = j + 1
For k = 1 To LC
brr(k, j) = arr(i, k)
Next k
End If
Next i
ReDim Preserve brr(LC, j)

Set wst = Sheets.Add(after:=ActiveSheet)
wst.Range("a1").Resize(j, LC) = Application.Transpose(brr)


I may not know well about red code(redim & Transpose), can you explain further?

I wish I could have a very clear expression about my question.

idnoidno
06-02-2017, 01:22 AM
Sub matchcheck2()
Dim rg As Object
Dim wst As Worksheet
Dim i As Long, j As Long, k As Long
Dim LR As Long, LC As Long
Dim StartRow As Long
Dim Col As Long, Txt As String
Dim arr
Dim brr
Col = 2
Txt = "Trial 03"
StartRow = 2


LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column


ReDim brr(LR, LC)
Set rg = Range(Cells(1, 1), Cells(LR, LC))
arr = rg
For i = StartRow To UBound(arr)
If InStr(arr(i, Col), Txt) > 0 Then
j = j + 1
For k = 1 To LC
brr(j, k) = arr(i, k)
Next k
End If
Next i


Set wst = Sheets.Add(after:=ActiveSheet)
wst.Range("a1").Resize(j, LC) = brr
End Sub


If I don't use redim, I could get almost the same result.
Do I have to use REDIM?




Test03
Trial 03
Other 03
More 52


Test07
Trial 03
Other 04
More 56


Test10
Trial 03
Other 03
More 59


Test14
Trial 03
Other 03
More 63


Test18
Trial 03
Other 04
More 67


Test21
Trial 03
Other 03
More 70





Test03
Trial 03
Other 03
More 52


Test07
Trial 03
Other 04
More 56


Test10
Trial 03
Other 03
More 59


Test14
Trial 03
Other 03
More 63


Test18
Trial 03
Other 04
More 67


Test21
Trial 03
Other 03
More 70

mdmackillop
06-03-2017, 01:38 AM
There are a lot of resources that can be found using Google e.g. https://excelmacromastery.com/excel-vba-array/

idnoidno
06-04-2017, 03:34 AM
Option Explicit
Sub filterCopy()
Dim lastrow As Integer
Dim lastcolumn As Integer
Dim rg As Range
Dim i As Integer, j As Integer, k As Integer
Dim arr As Variant
Dim brr()
Set rg = [a1].CurrentRegion
arr = rg
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
ReDim brr(1 To lastrow, 1 To lastcolumn - 1)
k = 1
For i = 2 To lastrow
If arr(i, 7) = "Y" Then
For j = 1 To lastcolumn - 1
brr(k, j) = arr(i, j)
Next j
k = k + 1
End If
Next i
Worksheets("sheet2").Select
Range("a1").Resize(UBound(brr, 1), UBound(brr, 2)) = brr
Set rg = Nothing
End Sub


Although this CODE can be carried out, but the scope of redim is declared relatively large, I think this is not the right way, how can I change it?

mdmackillop
06-04-2017, 04:49 AM
I'm giving up on Redim. Just use Filter+Copy

Option Explicit
Sub filterCopy()
Dim rng As Range
Set rng = Range("A1").CurrentRegion
With rng
.AutoFilter Field:=7, Criteria1:="Y"
.Offset(1).Resize(rng.Rows.Count - 1, rng.Columns.Count - 1).Copy Sheets(2).Range("A1")
.AutoFilter
End With
End Sub