Using If function to separate data into multiple sheet

[mt_1610]

Hello,
I have a master sheet that I would like to split it into multiple sheets based on Column A (Date In) . In master sheet, it has 4 columns: A: Date In, B: Name, C: ##, D: Date Out. This is the way I would like how If function work: If any cell of column A in master sheet matches with B1 (a date cell) on any of my sheets, the value in column C will go on cell L216 of that sheet. I really need your help.

For example:
In A2: 4/3/17 (Master sheet) matches with B1: 4/3/17 (Sheet 1), so the value of C2 (Master sheet) would be on L216 (Sheet 1)
If(A2 (Master) = B1 (Sheet 1), L216 (sheet 1) = C2 (Master Sheet), "")

Another example:
In A5: 4/8/17 (Master sheet) matches with B1: 4/8/17 (Sheet 5), C2 (Master sheet) would be on L216 (Sheet 5)
If(A5 (Master) = B1 (Sheet 5), L216 (sheet 5) = C5 (Master Sheet), "")

I appreciate your help!

[offthelip]

in L216 of all the sheets except master sheet put the following formula:

=INDEX(Master!C1:C1400,MATCH(B1,Master!A1:A1400,0))

Note you will need to change the 1400 to the last row use on you master sheet if you are using more than 1400 rows

[mt_1610]

in L216 of all the sheets except master sheet put the following formula:

=INDEX(Master!C1:C1400,MATCH(B1,Master!A1:A1400,0))

Note you will need to change the 1400 to the last row use on you master sheet if you are using more than 1400 rows

Thank you for your response,
Using this formula is exactly what I would like how it works, but when I copy this function to multiple sheet, my workbook performs the tasks very slow. I think I need a VBA code for it. May you help me out, please?

[offthelip]

try this:

Sub testsub()
 Dim WS_Count As Integer
 Dim I As Integer
 Worksheets("Master").Select
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 3))
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
 Worksheets(I).Select
  If Not (Worksheets(I).Name = "Master") Then
  For j = 2 To lastrow
   If inarr(j, 1) = Cells(1, 2) Then
     Cells(216, 12) = inarr(j, 3)
     Exit For
   End If
  Next j
End If
Next I
End Sub

[rlv]

Cross posted

https://www.mrexcel.com/forum/excel-...ple-sheet.html

[snb]

@offthelip

'Select' and 'Activate' are 'very avoidable' in VBA.

[offthelip]

snb
thanks, Old habits die hard, and it is very easy to code.
It is one thing I hadn't thought about until I started posting on the forum

[mt_1610]

It works like a charm, I very appreciate your help. I still have 3 tasks need the code runs. May you help me out, please?
1. A date has more than 1 transaction. For example: If 4/2/17 has 3 transactions, those transactions would be on L216, L217, L218 in a sheet that has B1 = 4/2/17.
2. I want the code runs Date Out like the same it runs Date In. So, If a cell in Date Out column (Master sheet) match with B1 (a Date cell in Sheet1,2...), the value in column C will start at cell M216 of that sheet.
3. May you make the code run automatically, please?
Tables below are similar to my worksheet.
This table is in Master sheet

Date In	Name	##	Date Out
4/1/17	abc	$15,000	4/2/17
4/1/17	abc1	$30,000	4/2/17
4/2/17	bcd	$500	4/4/17
4/2/17	bcd1	$7,000	4/5/17
4/2/17	bcd2	$5,000	4/6/17
4/3/17	fgh	$300	4/4/17
4/3/17	tgh	$400	4/6/17
4/3/17	ret	$200	4/5/17
4/3/17	rew	$100	4/7/17

This table is in Sheet2 and it will be the same in another sheet (Sheet1, Sheet3, ...). If the code runs, it is the result of sheet2

Column B	Column L	Column M
B1: 4/2/17	IN	OUT
216	$500	$15,000
217	$7,000	$30,000
218	$5,000
219
220
221
222
....	...	....

[offthelip]

mt_1610
You have been severely testing the incentive to help you, firstly by cross posting without acknowledging it and secondly by not giving your full requirements in your original post.
Please read this article on cross posting:
http://www.excelguru.ca/content.php?184

[offthelip]

Here is the code that will do the "date in" for you with multiple date, and I have taken account of snb comment
You will have to work out how to do the date outs yourself..

Sub testsub()
 Dim WS_Count As Integer
 Dim I As Integer
 Dim rowcounter() As Integer
With Worksheets("Master")
lastrow = .Cells(Cells.Rows.Count, "A").End(xlUp).Row
inarr = .Range(.Cells(1, 1), .Cells(lastrow, 3))
End With
WS_Count = ActiveWorkbook.Worksheets.Count
ReDim rowcounter(1 To WS_Count)
For I = 1 To WS_Count
 rowcounter(I) = 0
  With Worksheets(I)
  If Not (.Name = "Master") Then
    For j = 2 To lastrow
     If inarr(j, 1) = .Cells(1, 2) Then
       .Cells(216 + rowcounter(I), 12) = inarr(j, 3)
       rowcounter(I) = rowcounter(I) + 1
     End If
    Next j
  End If
End With
Next I
End Sub

[mt_1610]

Here is the code that will do the "date in" for you with multiple date, and I have taken account of snb comment
You will have to work out how to do the date outs yourself..

Sub testsub()
 Dim WS_Count As Integer
 Dim I As Integer
 Dim rowcounter() As Integer
With Worksheets("Master")
lastrow = .Cells(Cells.Rows.Count, "A").End(xlUp).Row
inarr = .Range(.Cells(1, 1), .Cells(lastrow, 3))
End With
WS_Count = ActiveWorkbook.Worksheets.Count
ReDim rowcounter(1 To WS_Count)
For I = 1 To WS_Count
 rowcounter(I) = 0
  With Worksheets(I)
  If Not (.Name = "Master") Then
    For j = 2 To lastrow
     If inarr(j, 1) = .Cells(1, 2) Then
       .Cells(216 + rowcounter(I), 12) = inarr(j, 3)
       rowcounter(I) = rowcounter(I) + 1
     End If
    Next j
  End If
End With
Next I
End Sub

Thank you so much!!! It is exactly what I would like how it work.

[mt_1610]

I have tried the code below to run Date In and Date Out at the same time, but it didn't work as expected. May you help me one more time, please?

Private Sub Worksheet_Activate()
Dim WS_Count As Integer
Dim I AsInteger
    Dim rowcounter() As Integer
With Worksheets("Menu")
Lastrow = .Cells(Cells.Rows.Count, "A").End(xlUp).Row
        Lastrow = .Cells(Cells.Rows.Count, "D").End(xlUp).Row
        inarr = .Range(.Cells(1, 1), .Cells(Lastrow, 4))
EndWith
    WS_Count = ActiveWorkbook.Worksheets.Count
    ReDim rowcounter(1 To WS_Count)
    For I = 1 To WS_Count
        rowcounter(I) = 0
        With Worksheets(I)
            If Not (.Name = "Menu") Then
                For j = 3 To Lastrow
                    If inarr(j, 1) = .Cells(1, 2) Then
                        .Cells(216 + rowcounter(I), 11) = inarr(j, 3)
                        rowcounter(I) = rowcounter(I) + 1
                    ElseIf inarr(j, 4) = .Cells(1, 2) Then
                        .Cells(216 + rowcounter(I), 12) = inarr(j, 3)
                        rowcounter(I) = rowcounter(I) + 1
                    End If
                Next j
            End If
        End With
    Next I
End Sub

[offthelip]

Try this, Note I haven't tested this, or even tried to compile it, so there may well be errors

Private Sub Worksheet_Activate()
Dim WS_Count As Integer
Dim I AsInteger
Dim rowcounterA() As Integer
Dim rowcounterD() As Integer
With Worksheets("Menu")
LastrowA = .Cells(Cells.Rows.Count, "A").End(xlUp).Row
LastrowD = .Cells(Cells.Rows.Count, "D").End(xlUp).Row
if LastrowA > lastrowD
inarr = .Range(.Cells(1, 1), .Cells(LastrowA, 4))
else
inarr = .Range(.Cells(1, 1), .Cells(LastrowD, 4))
endif
EndWith
WS_Count = ActiveWorkbook.Worksheets.Count
ReDim rowcounterA(1 To WS_Count)
ReDim rowcounterD(1 To WS_Count)
For I = 1 To WS_Count
rowcounterA(I) = 0
rowcounterD(I) = 0
With Worksheets(I)
If Not (.Name = "Menu") Then
For j = 3 To LastrowA
If inarr(j, 1) = .Cells(1, 2) Then
.Cells(216 + rowcounterA(I), 11) = inarr(j, 3)
rowcounterA(I) = rowcounterA(I) + 1
endif
nextj
For j = 3 To LastrowD
If inarr(j, 4) = .Cells(1, 2) Then
.Cells(216 + rowcounterD(I), 12) = inarr(j, 3)
rowcounterD(I) = rowcounterD(I) + 1
End If
Next j
End If
End With
Next I
End Sub

[mt_1610]

Thank you for your help! When I put the code on my workbook, it didn't run and appeared a message "Compile error: Syntax error". Private Sub Worksheet_Activate() is highlighted, and If LastrowA > lastrowD turned red.

[offthelip]

If LastrowA > LastrowD then

[mt_1610]

It's perfect. Can I use multiple codes in one sheet or I have to combine them together? I very appreciate your help.

If LastrowA > LastrowD then

[snb]

Please do not quote !

[offthelip]

Can I use multiple codes in one sheet or I have to combine them together?

I don't understand the question!

[mt_1610]

I have 2 codes which run in the same sheet, and they do different tasks. When they runs together, my excel often freezes. I am trying to figure it out how to run them.

1) This code runs when I put 1 in column M and the row has 1 in column M will be hidden.

Private Sub Worksheet_Calculate()
Dim Lastrow As Long, c As Range
Application.EnableEvents = False
Lastrow = Cells(Cells.Rows.Count, "M").End(xlUp).Row
OnErrorResumeNext
For Each c In Range("M3:M" & Lastrow)
   If c.Value = 1000 Then
        c.EntireRow.Hidden = True
    ElseIf c.Value = 0 Then
        c.EntireRow.Hidden = False
EndIf
Next
OnErrorGoTo0
Application.EnableEvents = True
End Sub

2) This code you've just written for me

Private Sub Worksheet_Activate()
Dim WS_Count As Integer
Dim I AsInteger
    Dim rowcounterA() As Integer
    Dim rowcounterD() As Integer
    With Worksheets("Menu")
Lastrowa = .Cells(Cells.Rows.Count, "AF").End(xlUp).Row
        lastrowD = .Cells(Cells.Rows.Count, "AJ").End(xlUp).Row
        If Lastrowa > lastrowD Then
        inarr = .Range(.Cells(1, 1), .Cells(Lastrowa, 36))
Else
        inarr = .Range(.Cells(1, 1), .Cells(lastrowD, 36))
        End If
        End With
        WS_Count = ActiveWorkbook.Worksheets.Count
        ReDim rowcounterA(1 To WS_Count)
        ReDim rowcounterD(1 To WS_Count)
        For I = 1 To WS_Count
            rowcounterA(I) = 0
            rowcounterD(I) = 0
            With Worksheets(I)
                If Not (.Name = "Menu") Then
                    For j = 3 To Lastrowa
                        If inarr(j, 32) = .Cells(1, 2) Then
                            .Cells(216 + rowcounterA(I), 11) = inarr(j, 35)
                            rowcounterA(I) = rowcounterA(I) + 1
                            End If
                            Next j
For j = 3 To lastrowD
                                If inarr(j, 36) = .Cells(1, 2) Then
                                    .Cells(216 + rowcounterD(I), 12) = inarr(j, 35)
                                    rowcounterD(I) = rowcounterD(I) + 1
                                End If
                            Next j
                        End If
                    End With
                Next I
End Sub

[offthelip]

I suggest you put
Application.EnableEvents=False at the start of the Worksheet_Activate
and
Application.EnableEvents=True at the end of it

the problem is that when you open the workbook the Worksheet_ activate routine gets called and thi8s writes values out to the cells which will automatically trigger the worksheet_calculate every time a cell is written, ie many many time before the worksheet active subroutine has finished.