idnoidno

05-31-2017, 02:39 AM

Will the use of instr, how to edit brr and find out(filter) all the data ?

19349

19349

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

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.

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.

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

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?

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

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

Powered by vBulletin® Version 4.2.5 Copyright © 2020 vBulletin Solutions Inc. All rights reserved.