Posts by Insomniac

I dont think you can capture the entries in a sheet until enter is pressed. A possible solution may be to use a textbox to enter the digits and apply to the sheet with code.

Using a textbox from the control toolbox and some code a bit like this:

Private Sub TextBox1_Change()
Static cl As Integer, rw As Long, x As Boolean
    
    If x Then Exit Sub
    
    If cl = 0 Or cl > 5 Then
        cl = 1: rw = rw + 1
        If rw > 1 Then ActiveWindow.SmallScroll Down:=1
    End If
    
    Cells(rw, cl) = Right(TextBox1.Text, 1): cl = cl + 1
    
    x = True: TextBox1.Text = Right(TextBox1.Text, 1): x = False
    
    TextBox1.Top = Cells(rw, cl).Top
    
End Sub

The Static variables will remeber what cell you are up to if you have to click back on the sheet to fix a mistake.
You may need to enhance the code a bit to include a reset or backspace feature etc.

This cumbersome single cell formula should work provided there is always 3 sets of brackets and you dont use the "~" tilde character in the strings:

=VALUE(MID(A1,FIND("(",A1,1)+1,FIND(")",A1,1)-(FIND("(",A1,1)+1)))+VALUE(MID(A1,FIND("~",SUBSTITUTE(A1,"(","~",2),1)+1,FIND("~",SUBSTITUTE(A1,")","~",2),1)-(FIND("~",SUBSTITUTE(A1,"(","~",2),1)+1)))+VALUE(MID(A1,FIND("~",SUBSTITUTE(A1,"(","~",3),1)+1,FIND("~",SUBSTITUTE(A1,")","~",3),1)-(FIND("~",SUBSTITUTE(A1,"(","~",3),1)+1)))

(Richie's UDF would be far more flexible though)

Ah my Inbox has been going berserk with email notifications! Thought I better take a look!

Yes Dave I thought about Display Alerts = False but thought SaveChanges = False would suffice and be more reliable in this case.

Insomniac

Workbooks(OrigFilename).Close False

You can set the variable as a required argument in the sub:

Sub Macro1(mes As String) 'in BookA
    MsgBox mes
End Sub


Sub Macro2() 'in BookB
Dim Str As String
    Str = "Hello"
    Application.Run "'BookA.xls'!Macro1", Str
End Sub

If you require the sub to return a value, change it to a function:

Function Func1(a As Long, b As Long) As Long 'in BookA
    Func1 = a + b
End Function


Sub Macro3()  'in BookB
Dim c As Long    
c = Application.Run("'BookA.xls'!Func1", 5, 4)
    MsgBox c
End Sub

Pesky Weasel,

Modified your code to work the same as mine, the slow part of my code was applying the array back to sheet2, your line:
Sheets(2).Range("a1").Resize(iDiv, iElem).Value = data2 is a far better way.

Option Explicit
Option Base 1
 
Sub ForJack2()
 
Dim data
Dim data2()
Dim iDiv As Long
Dim i As Long
Dim x As Long


With Sheets("Sheet1")
    data = .Range(.Range("a9"), .Range("a65536").End(xlUp)).Value
End With


iDiv = WorksheetFunction.RoundUp(UBound(data) / 12, 0)
 ReDim data2(iDiv, 3)
  x = 1
    For i = 1 To UBound(data) Step 12
        data2(x, 1) = data(i, 1)
        data2(x, 2) = data(i + 4, 1)
        data2(x, 3) = data(i + 8, 1)
        x = x + 1
    Next i


Sheets(2).Range("a1").Resize(iDiv, 3).Value = data2
 
End Sub

Pesky Weasel, that's pretty nice solution, although you are transposing all the data it could be modified to transfer only the rows Jack want's.
Both ways are lightning fast, but yours is fractionally faster than mine!
I'm sure Jack would be keen for a modified version.

Hi there Jack, Had a bit of time this afternoon so thought I'd have a go:

Option Explicit


Sub Jack_ArrayCopy()
Dim rw As Long, cnt As Long
Dim Rng(), Wb As Workbook
Dim Sh1 As Worksheet, Sh2 As Worksheet
    
    Application.Calculation = xlCalculationManual
    Set Wb = ThisWorkbook: cnt = 0
    
    Set Sh1 = Wb.Sheets("Sheet1")
    With Sh1
        rw = .Range("A65536").End(xlUp).Row
        'round down 'cnt' in case decimal divison!
        cnt = WorksheetFunction.RoundDown((rw - 9) / 12, 0)
        'MsgBox "Copy Sheet1 A9:A" & rw & Chr(10) & " to " & "Sheet2 A1:A" & cnt + 1
        ReDim Rng(cnt, 2)
        cnt = 0
        For rw = 9 To rw Step 12
            Rng(cnt, 0) = .Cells(rw, 1)
            Rng(cnt, 1) = .Cells(rw + 4, 1)
            Rng(cnt, 2) = .Cells(rw + 8, 1)
            cnt = cnt + 1
        Next
    End With
        
    Set Sh2 = Wb.Sheets("Sheet2")
    With Sh2
        For rw = 1 To cnt
            .Cells(rw, 1) = Rng(rw - 1, 0)
            .Cells(rw, 2) = Rng(rw - 1, 1)
            .Cells(rw, 3) = Rng(rw - 1, 2)
        Next
    End With
    
    ReDim Rng(0, 0)
    Set Sh1 = Nothing
    Set Sh2 = Nothing
    Set Wb = Nothing
    Application.Calculation = xlCalculationAutomatic
End Sub

Hope this is something like what your after, see attached sample.

(Think sample is too large too attache, made over 5000 rows of data but it works pretty quick)

Richie, have followed this thread with interest, have not had a chance to test all the possible variations with the new suggetions, do you consider your question solved?

Yes, I knew my response was not exactly what you were after but I think it is an interesting challenge and am keen to see a more comprehensive answer and explanation from an array "Expert".

Quote

Hi sleepless one

hey yeah it is 4,30am here, bedtime a while away yet!

Richie, combing your example2 with kundepuu's attempt I do not see any crashes.

Sub Empty_Arrays2()
    Dim l As Long, arrTest() As String
     
    For l = 1 To 5
        'ReDim Preserve arrTest(1 To l)
        'arrTest(l) = CStr("Number :" & l)
        'arrTest(l) = ""
    Next l
    
    On Error GoTo NBG
    'MsgBox WorksheetFunction.CountA(arrTest())
    
    For l = LBound(arrTest) To UBound(arrTest)
        If Not (arrTest(l)) = Empty Then MsgBox "Not Empty": Exit Sub
    Next
        
NBG: If Err.Number <> 0 Then Exit Sub
    On Error GoTo 0
    MsgBox "Empty"
     
End Sub

Note: I tried the CountA function on the array but it always returns the ubound of the array not the usual worksheet result.

Just having a go!

Iam not familiar with the technique you describe but it sounds like the OnTime method would solve your problem.

Option Explicit
Dim tmprng As String
Dim tmpval


Sub StockPrice_OnNewData()
Dim rw As Long
Dim cl As Integer
    'get update
    rw = 1
    cl = 1
    tmprng = Cells(rw, cl).Address
    tmpval = "Cell Updated"
    Application.OnTime Now, "Update"
End Sub


Sub Update()
Range(tmprng).Value = tmpval
MsgBox "cell " & tmprng & " updated"
End Sub

By setting the Update to run OnTime, Excel will wait until edit mode is off before running the Update procedure.

Thanks, Jack and Ivan for replies.

I will mark this as solved if I can work out where to do it.

I will stick with the addin as is, it works fine on most of the comps i have checked because of other buttons that i have added to the Worksheet Command Bar that pushes the Window button far enough to the right to make the dropdown appear under the control. On some comps it drops down to the right but it dosnt affect the the end result.

At least I know I have not overlooked some simple property or setting!

BTW been offline for a few days doing a complete reinstall as I turned on the comp and got "system.ini" error, could not recover from this error so into the cupboard to find all the recovery softwear etc. Computers can really be great fun sometimes especially when they crash for no apparent reason!

Thanks again.

p.s. Oh yeah there is a big green solved button, doh!

hi again, iam still toying with this and would be interested in any further comments.

Perhaps to recap, if you download the addin in my original post and set your screen resolution to 800x600 the dropdown list will align itself neatly to the bottom of the Window menu.If you set the screen resolution higher the dropdown list will appear to the right of the control.

Can we force the dropdown to always align itself under or over the control no matter what resolution of the screen?

Or am I trying to manipulate something that is not possible?

p.s. the addin uses a class module to update the list whenever a workbook or sheet is added, and works as i wish, I
want to avoid a completely seperate toolbar or other menu.

Hi AndyPope.

Quote

BTW, I assume you know that by right clicking the sheet selector buttons (bottom left of workbook) a list of worksheets is displayed. and if the list is too long a dialog is displayed

yes iam aware of this method but my users know very little, besides that way will not display all the sheets in all the open workbooks.

Quote

I believe the right align would be the normal behaviour.

yes it seems that right align is the default behaviour, but i would prefer to align direclty below or above the control to avoid confusion with users who expect it to be so.

Quote

How about creating the control on a toolbar. The default action there is to drop down below/above the control.

yes this would suit myself but my users are very green and tend go to the Window button, it was therefore logical to add a control to to that menu to display all the worksheets available to them.

At the end of the day Iam only trying to program around the lack of training and experience of my end users.

Just another thought since JackinUk mentioned it, I need for this to work consistently with Excel97 and up. Any comments as for other versions are appreciated. Again thanks Jack for the reply.

OK Jack, thanks for the response. BTW never seen a post full of strikethrough before!.

Anyway I tried your revised code but to no avail, I actually would prefer the dropdown list to appear either directly below or above the control itself regardless of screen resolurion.

Yeah, I saw the messed up reply, trying your suggestion now.

Just to clarify, if you for instance set the width of the control to 300, the dropdown list will apppear to the right of the control at a screen resolution of 1024x768 or greater!