Arrays

[Kenny]

A big ask, but if anyone can help, it would be great. I'm
getting tied up in nested for...next loops and ifs.

I have a square array K(n,n)

I also have a vector array Vector(n)

The entries in Vector() are either 1 or 0, i.e
(1,1,0,0,1,1). Here n = 6

There are a total of 4 1's in Vector in this example.

I need to reduce K() by deleting the rows and columns
corresponding to the location of a 1 in Vector() to obatin
K_Red

Continuining the above example: K_Red(2,2)

The entries in K_Red() will correspond to entries in K()
at the following locations.

i.e. K_red(1,1)=K(3,3), K_red(1,2)=K(3,4)
K_red(2,1)=K(4,3), K_red(2,2) =K(4,4)

Now how can I do the same where n is a large number.

 

[Stephen Rasey]

Try this. It is untested, but I think it is very close to an efficient
answer.

Option Explicit
Sub KtoRed()
'by Stephen Rasey, http://excelsig.com, 040825
'untested - draft answer to
Dim rngKRedUL As Range ' KRed Array Upper Left cell
Dim rngK As Range
Dim rngV As Range
Dim avV(256) As Variant 'variant array for to hold 0s indexes from rngV
Dim avKRed() As Variant '2D array to hold the KRed output.
Dim i As Integer
Dim j As Integer
Dim iVV As Integer 'counter for the avV array
Dim nVV As Integer 'the number of 0s in V
Dim rngVcell

'set Ranges (omitted)
'Set up the first pass to get the mapping.
i = 0
For i = 1 To rngV.Cells.Count
If rngV(i) = 0 Then 'a short cut syntax that I think
works. rngV.cells(i)
iVV = iVV + 1
avV(iVV) = i
End If
Next
nVV = iVV

ReDim avKRed(nVV, nVV)
For i = 1 To nVV
For j = 1 To nVV
avKRed(i, j) = rngK.Cells(avV(i), avV(j))
Next j
Next i

'write the avKred output array to the Excel Output range.
rngKRedUL.Resize(nVV, nVV) = avKRed
End Sub

 

[Stephen Rasey]

Try this. It is untested, but I think it is very close to an efficient
answer.

Option Explicit
Sub KtoRed()
'by Stephen Rasey, http://excelsig.com, 040825
'untested - draft answer to
Dim rngKRedUL As Range ' KRed Array Upper Left cell
Dim rngK As Range
Dim rngV As Range
Dim avV(256) As Variant 'variant array for to hold 0s indexes from rngV
Dim avKRed() As Variant '2D array to hold the KRed output.
Dim i As Integer
Dim j As Integer
Dim iVV As Integer 'counter for the avV array
Dim nVV As Integer 'the number of 0s in V
Dim rngVcell

'set Ranges (omitted)
'Set up the first pass to get the mapping.
i = 0
For i = 1 To rngV.Cells.Count
If rngV(i) = 0 Then 'a short cut syntax that I think
works. rngV.cells(i)
iVV = iVV + 1
avV(iVV) = i
End If
Next
nVV = iVV

ReDim avKRed(nVV, nVV)
For i = 1 To nVV
For j = 1 To nVV
avKRed(i, j) = rngK.Cells(avV(i), avV(j))
Next j
Next i

'write the avKred output array to the Excel Output range.
rngKRedUL.Resize(nVV, nVV) = avKRed
End Sub

 

[Stephen Rasey]

It is probably a good idea to use
Option Base 1
my Dim statements do not specify a lower bound.

Stephen Rasey

 

[Stephen Rasey]

In your example

nVV = 2
avV(1) = 3
avV(2) = 4

For i = 1 To nVV
For j = 1 To nVV
avKRed(i, j) = rngK.Cells(avV(i), avV(j))
Next j
Next i

When i = 1, j=2
avKRed(1,2) = rngK.cells(avV(1),AvV(2))
avKRed(1,2) = rngK.cells(3,4)

This subroutine ought to be blazingly fast even for nVV about 30.

Stephen Rasey
Houston
http://wiserways.com
http://excelsig.org

 

[Kenny]

Thanks, that works a treat.