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-questions/1000754-using-if-function-separate-data-into-multiple-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.

[mt_1610]

I'm sorry, I didn't get that. May you show me where I put those lines, please?

[offthelip]

Private Sub Worksheet_Activate()


Dim WS_Count As Integer
Dim I AsInteger
Dim rowcounterA() As Integer
Dim rowcounterD() As Integer
Application.EnableEvents = False
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
Application.EnableEvents = True
EndSub