Simultaneous Entry

[Dimitriy]

Hey guys,

Here is a quick question for you. Please look at the sample file. I want to be able to enter simultaneously data in another workbook. More specifically, I need to have an automatic entry of numbers from Column A of Sheet 1 into Column A of Sheet 2, only if the corresponding numbers in Column B OR Column C of Sheet 1 is equal to "1". So in the sample, numbers 1, 4, 6, 8, and 10 should be displayed in Column A of Sheet 2.

Is there an elegant way of doing this?

Thank you.

[D_Rennie]

hello, try running this

Sub VBA()
'D_Rennie  16/1/2010
Dim LR As Long

With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Goto ThisWorkbook.Sheets(1).Cells(1, 1)
    With ThisWorkbook
    
        With Sheets(1)
        LR = .Range("A" & .Rows.Count).End(xlUp).Row
        End With
    
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "TestVBA"
        
        With .Sheets("TestVBA")
            .Range(.Cells(2, 1), .Cells(LR, 1)).FormulaR1C1 = _
                "=IF(Sheet1!RC="""","""",IF(OR(Sheet1!RC[1]=1,Sheet1!RC[2]=1),Sheet1!RC,""""))"
            .Columns(1).SpecialCells(xlCellTypeFormulas, 1).EntireRow.Copy ThisWorkbook.Sheets(2).Range("A1")
            .Columns(1).ClearContents
        End With
    
    .Sheets("TestVBA").Delete
    End With
    
.DisplayAlerts = True
.ScreenUpdating = True
End With

cheers

[p45cal]

Here is a quick question for you

Yeah, sure.. here's a not so quick response! :

Three solutions in the attached file. In all cases for automated appearance of values put the formulae in first, though it doesn't really matter when you put the formulae in:
1. 'Orrible formula, array-entered into all the cells at once (Ctrl+Shift+Enter) (See sheet2):
=INDEX(Sheet1!$A$1:$A$11,SMALL(IF(((Sheet1!$B$2:$B$11=1)--(Sheet1!$C$2:$C$11=1)),ROW()),ROW()-1))
leaves lots of #NUM errors where there are no more results to be displayed.

2. User defined function used thus in a worksheet (see Sheet3):
=blah(range,nth) where range is a 3 column contiguous block of data (don't forget to use the $ sybols throughout to make that range absolute), and

nth is the index number of which result you want to appear; Normally you'd start at 1, then 2, 3 etc.
Instead of manually typing in 1, 2 3 etc. for nth you can use ROW() which returns the row number the formula is in then subtract a constant as I have done on this sheet.

Because it uses a loop, if your list is very long it might not be very efficient.

User defined functions need macros to be enabled for them to work.
Supported by this function:
[vba]Function blah(theRange, nth)
i = 0
blah = ""
For Each rw In theRange.Rows
If rw.Cells(2) = 1 Or rw.Cells(3) = 1 Then
i = i + 1
If i = nth Then
blah = rw.Cells(1).Value
Exit For
End If
End If
Next rw
End Function
[/vba]
3. Another, more robust user defined function (see Sheet4):
use as follows:
=blah2(range,nth)
the same as my first attempt (blah), eg:
=blah2(Sheet1!$A$2:$C$11,ROW()-1)

This should be more robust and quicker if you have a long list.
Supported by this function:
[vba]Function blah2(theRange, nth)
Dim SecondCol As Range, ThirdCol As Range, FirstCol As Range
blah2 = ""
Set FirstCol = theRange.Columns(1)
Set SecondCol = theRange.Columns(2)
Set ThirdCol = theRange.Columns(3)
yy = Evaluate("INDEX(" & FirstCol.Address(, , , True) & ",SMALL(IF((" & SecondCol.Address(, , , True) & " = 1)+(" & ThirdCol.Address(, , , True) & " = 1),ROW(" & SecondCol.Address & ")-" & FirstCol.Row & " + 1)," & nth & "))")
If Not IsError(yy) Then blah2 = yy
End Function
[/vba]I'm sure it could be slicker.

[mikerickson]

This uses Advanced Filter
[vba]Sub test()
Dim sourceRange As Range
Dim destinationRange As Range
Dim critRange As Range

Rem define source and destination ranges
With ThisWorkbook.Sheets("Sheet1")
Set sourceRange = Range(.Cells(1, 3), .Cells(.Rows.Count, 1).End(xlUp))
End With
Set destinationRange = ThisWorkbook.Sheets("Sheet2").Range("A1")

Rem define and fill crit range
With sourceRange.Parent.UsedRange
Set critRange = .Cells(1, .Columns.Count + 2).Resize(3, 2)
End With
With critRange
.Cells(1, 1).Value = sourceRange.Cells(1, 2).Value
.Cells(1, 2).Value = sourceRange.Cells(1, 3).Value
.Cells(2, 1).Value = 1
.Cells(3, 2).Value = 1
End With

Rem copy filter
sourceRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=critRange, _
CopyToRange:=destinationRange, Unique:=False

Rem clean up
critRange.Delete shift:=xlUp
End Sub[/vba]

[Dimitriy]

Hey p45cal,

Thank you so much for your solutions. I decided to use solution #3. But in trying to adapt it to my actual spreadsheet I having a bit of a problem.

Please see the Updated Sample file. I have changed the arrangement of the columns on Sheet 1, turned those columns into dropdowns, and changed column 1 of Sheet 1 back to numbers.

Can you please help me with getting the code to work with these changes?

Also, does the VBA code have to be in a module folder or just a code under a specific sheet?

Thanks,
Dimitriy

[p45cal]

Hey p45cal,

Thank you so much for your solutions. I decided to use solution #3. But in trying to adapt it to my actual spreadsheet I having a bit of a problem.

Please see the Updated Sample file. I have changed the arrangement of the columns on Sheet 1, turned those columns into dropdowns, and changed column 1 of Sheet 1 back to numbers.

Can you please help me with getting the code to work with these changes?

Also, does the VBA code have to be in a module folder or just a code under a specific sheet?

Thanks,
Dimitriy

I've just tried this and it seems to work as expected. You've amended the function as I would have. What doesn't work?

I would put the code in a code module.

[Dimitriy]

Looks like it's working now, but it is slowing down the whole worksheet quite a bit. This is especially a problem when I am trying to input data in Sheet 1 (the spreadsheet pauses to calculate almost after every cell entry). I originally put =blah2(Sheet1!$A$2:$H$1000000,ROW()-1), but that killed the efficiency because of all calculations. So I just had to reduce it to H100, which won't last long.

Do you have any suggestions on how to improve the current calculations time? Or perhaps disable the formula, when not needed...

Thanks a bunch,
Dimitriy

[p45cal]

The problem here is that you wanted simultaneous and automated entry. All my solutions do this - in addition, should you amend an existing line on the data-entry sheet, the automated sheet is kept up to date, which means it has to recalculate itself frequently. I note that in the Modified version you still have all three solutions active - The first user defined function (UDF) I suggested (blah) is, I think, more resource hungry thatn the second (blah2); you've not still got the blah formula in lots of rows too have you? Likewise, the first, array-entered solution isn't also present in a large block on a sheet is it? It too could take significant time to calculate. So make sure you've only got one sheet to recalcualte every time.

Otherwise, you have several options:
1. Switch off automatic calculation, but you'll have to press F9 to calculate manually from time to time. This is an application level setting, so would affect all open workbooks/sheets.
2. Once you're sure that a secton of the resultant sheet can be set in concrete, you can copy/Paste|Special|Values in situ to convert those formulae results to plain values.
3. Abandon the simultaneous aspect of this and use mikerickson's solution periodically.
4. Retain the simultaneous aspect by using mikerickson's code at every change in the relevant columns of the data-entry sheet. I imagine it would be faster than calculating lots of UDFs. Be aware, that as the list gets longer on the resultant list it will overwrite anything already there. (In fact, on testing this in xl2007 it overwrote the entire column A, to the bottom of the sheet.)
For this last option 4, use a variant of mikerickson's code in a standard code module:
[vba]Sub testmik()
On Error GoTo reEnable
Dim sourceRange As Range
Dim destinationRange As Range
Dim critRange As Range

Rem define source And destination ranges
With ThisWorkbook.Sheets("Sheet1")
Set sourceRange = Range(.Cells(1, "H"), .Cells(.Rows.Count, 1).End(xlUp))
End With
Set destinationRange = ThisWorkbook.Sheets("Sheet5").Range("A1") 'adjust sheet name to suit.

Rem define And fill crit range
With sourceRange.Parent.UsedRange
Set critRange = .Cells(1, .Columns.Count + 2).Resize(3, 2)
End With
With critRange
.Cells(1, 1).Value = sourceRange.Cells(1, "E").Value
.Cells(1, 2).Value = sourceRange.Cells(1, "H").Value
.Cells(2, 1).Value = 1
.Cells(3, 2).Value = 1
End With

Rem copy filter
sourceRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=critRange, _
CopyToRange:=destinationRange, Unique:=False

Rem clean up
critRange.Delete shift:=xlUp
reEnable:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
[/vba] and this in Sheet1's code module:
[vba]Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo reEnable
If Not Intersect(Union(Columns("E"), Columns("H")), Target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
testmik
End If
reEnable:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
[/vba] and see if that improves things.
Make sure there is NOTHING anywhere in the last 3 columns of sheet 1
Now does it run any faster?

[geekgirlau]

Simultaneous entry is always going to slow things down, and the more data you need to look at, the slower it will get.

The question to ask yourself is why does it need to be simultaneous - challenge this assumption or be prepared to deal with the speed (or lack thereof).

A much faster option is to transfer all the data that matches your criteria periodically, as in Mike's example (post #4).

[D_Rennie]

could you not run one of the codes above to get yourself on a baseline and then the worksheet change event to trasnpher any new row after that not the whole column, seams to me if that would do there would me no nitice in the performance of the workbbok.