Excel VBA: moving matrix in fix range to another sheet

zeno

Board Regular
Joined
Feb 16, 2012
Messages
71
Hello,
My objective is to select specific positions in a moving matrix of a fix range with VBA for Excel 2003. The fix range is about 5 or so columns wide and has a few thousand rows. I select a matrix of 5 to 7 rows and the same number of columns as range. I then choose a specific position number in this matrix, write that number in another sheet and move on the next matrix just below where I do the same, and this until the last line of the range.
I've tried to write a loop function but this seems to take a lot of execution time.
Can you share any of your thoughts on how to solve this?
Thank you.
Regards,
Zeno
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Well, there's a lot of unknowns:
How do you decide the specific position of 'specific positions in a moving matrix'?
Will the width be obvious in 'fix range is about 5 or so columns wide'?
How do you decide 5 , 6 or 7 in 'I select a matrix of 5 to 7 rows'?
How is the 'specific position number in this matrix' determined?

Perhaps seeing your code would give some idea - post it here?
 
Upvote 0
Thank you for your response.

I'm currently using the code below, which only partially answers to the question.
In this example I use data of 2 rows for columns A and B per matrix and get the values for average, max and min.
I also look for the 1st value in this 2*2 matrix, so in e.g. cell 1A, and try to select that position.

And it seems that using a loop is not so fast for a few thousand of rows?

Thank you.
Best,
Zeno


Code:
Function AverageFor4(dbl1 As Double, dbl2 As Double, dbl3 As Double, dbl4 As Double) As Double
   AverageFor4 = WorksheetFunction.Average(dbl1, dbl2, dbl3, dbl4)
End Function
   
Function QuoteHigh(dbl1 As Double, dbl2 As Double, dbl3 As Double, dbl4 As Double) As Double
   QuoteHigh = Application.WorksheetFunction.Max(dbl1, dbl2, dbl3, dbl4)
End Function

Function QuoteLow(dbl1 As Double, dbl2 As Double, dbl3 As Double, dbl4 As Double) As Double
   QuoteLow = Application.WorksheetFunction.Min(dbl1, dbl2, dbl3, dbl4)
End Function


Sub LoopExample()

   Dim ValueAvg As Double
   Dim ValueHigh As Double
   Dim ValueLow As Double
'   Dim VarRange As Variant
   
   ' *** ensure the active cell is first cell of avg column
   ' *** add open, close, high, low per 2 lines
    
    Do
     Application.ScreenUpdating = False
  
       ' ensure sheet1 is active
       Worksheets("sheet1").Activate
       ' retrieve the average value by passing the cell values to the ActiveCell.Offset(1, -2).Value)
       ValueHigh = QuoteHigh(ActiveCell.Offset(0, -1).Value, _
           ActiveCell.Offset(0, -2).Value, ActiveCell.Offset(1, -1).Value, ActiveCell.Offset(1, -2).Value)
       ValueLow = QuoteLow(ActiveCell.Offset(0, -1).Value, _
           ActiveCell.Offset(0, -2).Value, ActiveCell.Offset(1, -1).Value, ActiveCell.Offset(1, -2).Value)
        
       ' move to the next row
       ActiveCell.Offset(2, 0).Select
       ' select the 'avg' worksheet
       Worksheets("avg").Select
       ' copy the value to the activecell
       ActiveCell.Value = ValueAvg
       ActiveCell.Offset(0, 1).Select
       ActiveCell.Value = ValueHigh
       ActiveCell.Offset(0, 1).Select
       ActiveCell.Value = ValueLow
       ActiveCell.Offset(0, 1).Select
       ' move to the next row
       ActiveCell.Offset(1, -3).Select
       ' go back to sheet1
       Worksheets("sheet1").Select
       Application.ScreenUpdating = True
    Loop Until IsEmpty(ActiveCell.Offset(0, -1).Value)
    'Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
The code you've supplied gives a 3 column result on the avg sheet; the first column is all zero because you never give AvgValue any value.
The next two columns are the Max and Min respectively, of a 2x2 cell cluster to the left of the active cell, including the row beneath.

I have produced similar results with the below code which does no selecting at all except to set starting points on each sheet by selecting each sheet and looking at which is the active cell on each sheet. This isn't robust, but for the moment it will do.

A small difference is in the last low/min value where your function counts blank cells as 0, and my code, using the min function on a range ignores blanks. This only happens if you have incomplete record at the bottom of the source data.

I've guessed that maybe you were looking for an average value to be placed in the first column of the results - see comment in code where I have flagged this.

I've not used your functions at all.

This should run faster, but could be made to run a lot faster still, but I'd need to know more about source and destination sheet layouts.

Anyway, the code - don't forget to select the active cells on each sheet before you run it.
Code:
Sub LoopExample2()
Dim SrceCell As Range
Dim DestCll As Range
' *** ensure the active cell is first cell of avg column
' *** add open, close, high, low per 2 lines
Worksheets("sheet1").Activate
Set SrceCell = ActiveCell
Worksheets("avg").Activate
Set DestCll = ActiveCell

Do
  With SrceCell.Offset(0, -2).Resize(2, 2)
    DestCll.Value = Application.Average(.Value) 'this is a guess
    DestCll.Offset(0, 1).Value = Application.Max(.Value)
    DestCll.Offset(0, 2).Value = Application.Min(.Value)
  End With
  ' move to the next rows
  Set SrceCell = SrceCell.Offset(2)
  Set DestCll = DestCll.Offset(1)
Loop Until IsEmpty(SrceCell.Offset(0, -1).Value)
End Sub
 
Upvote 0
p45cal,

Thanks for your comments and dealing with 0 in the min function.
This is very helpful.

The development is not over yet, but you have gotten me far along the way.

Zeno
 
Upvote 0

Forum statistics

Threads
1,215,554
Messages
6,125,487
Members
449,233
Latest member
Deardevil

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top