Hi,
I need to do something like vLookup which will populate calls on one tab with information from another tab where the criteria will be matched in more than one row on the other tab without having blank lines on the destination tab.
Can anyone help or am I being too ambitious?

Hi,

Not too ambitious at all. Perhaps you could post a dummy workbook with some examples of what you need as results included?

File Attached :) eventually

Main Data is in tab SS
In tab '7945 Users' I need to populate cells in green columns with data from SS tab if (in SS tab) ColumnC = 7945 and ColumnH = Yes

In tab '7945 NoVM' I need to populate cells in green columns with data from SS tab if (in SS tab) ColumnC = 7945 and ColumnH = No


Hope this is enough to get you started.

Thanks

Are you adverse to having a few hidden columns to do all the hard work for you?

Basically, there are two ways of doing this that I can think of. One involves some quite complex (and by that I mean awkward to maintain when data requirements change) formulas. The other involves some hidden "helper columns" that are nice and easy to maintain.

Hi Spencer,
Hidden columns would be fine as long as they are to the right of the existing data as I will need to copy paste blocks of the data to another spreadsheet.

Data in the SS tab will change completely from job to job but the columns will not. The other tabs will stay the same throughout if that helps any.

Thanks

I have just found out that code can be attached to a tab.
Would it be possible to do the data copy using something like this?

Pseudo code for populating tabs

To run on entry to a tab -- Worksheet_Activate() ???

Start{
Do you want to update tab data?
no = end
yes = continue


current_line = 2 [which row to start data paste on]
for ss = 2 to 3000 [no of lines in SS tab with data]
if SS_tab_cell C'ss' = 7945 and SS_tab_cell H'ss' = Yes
then
copy SS_tab_cell F'ss' and paste value to current_tab_cell A'current_line'
copy SS_tab_cell G'ss' and paste value to current_tab_cell B'current_line'
copy SS_tab_cell E'ss' and paste value to current_tab_cell D'current_line'
copy SS_tab_cell M'ss' and paste value to current_tab_cell E'current_line'
copy SS_tab_cell N'ss' and paste value to current_tab_cell F'current_line'
current_line = current_line+1
next
else
next
endif

}End

Hi Caveman,

Try this code. You may need to change the sheet references and/or column references if I misinterpreted your sample. Otherwise, it seems to work fine on my machine.

Hope this helps,

Ben

Code:


Sub ParseData()
Dim lRow As Long
Dim sCol(1 To 5) As String
Dim lCol(1 To 5) As Long
Dim x As Long

'This sub will copy all pertinent data from the SS tab and copy it
'to two other tabs. Then, the sub will delete any unnecessary rows
'from these two tabs.

Application.ScreenUpdating = False 'Speeds up macro

'Last row of data on SS tab
lRow = Sheet8.Range("A50000").End(xlUp).Row

'Set the column references for the SS tab
sCol(1) = "F"
sCol(2) = "G"
sCol(3) = "E"
sCol(4) = "L"
sCol(5) = "N"

'Set the column reference number for the Users tab
lCol(1) = 1
lCol(2) = 2
lCol(3) = 4
lCol(4) = 5
lCol(5) = 6

'Copy data to tabs (Note: only copying the pertinent columns)
For x = 1 To 5
Sheet8.Range(sCol(x) & "2:" & sCol(x) & lRow).Copy
Sheet4.Range(Cells(2, lCol(x)).Address, Cells(lRow, lCol(x)).Address).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Next x

'Delete unused rows
For x = lRow To 2 Step -1
If Sheet8.Range(Cells(x, 3).Address).Value = "7945" And _
Sheet8.Range(Cells(x, 8).Address).Value = "Yes" Then
'Do nothing
Else
Sheet4.Range(x & ":" & x).Delete (xlUp)
End If
Next x

'Repeat for NoVM tab
lCol(1) = 1
lCol(2) = 2
'lCol(3) = 4 'Not used
lCol(4) = 5
lCol(5) = 6

'Copy data to tabs (Note: only copying the pertinent columns)
For x = 1 To 5
Sheet8.Range(sCol(x) & "2:" & sCol(x) & lRow).Copy
If x < 3 Then Sheet5.Range(Cells(2, lCol(x)).Address, Cells(lRow, lCol(x)).Address).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Next x

'Delete unused rows
For x = lRow To 2 Step -1
If Sheet8.Range(Cells(x, 3).Address).Value = "7945" And _
Sheet8.Range(Cells(x, 8).Address).Value = "No" Then
'Do nothing
Else
Sheet5.Range(x & ":" & x).Delete (xlUp)
End If
Next x

Application.ScreenUpdating = True

End Sub

Good Morning,

I thought about it some more, and I think you could do it just as easily with formulas. First, add a formula to any available column on the SS sheet (I used column S in the example below, but you may use a different one). In row 2 of that column enter the formula and fill down:

=C2&H2&COUNTIFS($C$2:C2, C2, $H$2:H2, H2)

The result will be a string with the model number, Yes/No, and a running count. For example, "7945Yes1" or "7945Yes23".

Now, go to the tabs with your data and enter an INDEX formula to MATCH the items you want and pull in the correct column. In this example, I placed the formula in Cell B2 and referenced the SS tab range A:S, where column S contains the formula mentioned earlier in this post. The formula to enter is:

=IF(ISNA(MATCH("7945Yes" & ROW(A1), Sheet1!S:S,0)), "", INDEX(SS!A:S, MATCH("7945Yes" & ROW(A1), SS!S:S,0), 4))

In this formula, any "#N/A" values return a null string. Since the formula starts in row 2, I use a relative reference to the row of cell A1 to increment the counter (the formula ROW(A1) returns "1", so as you copy it down, the number increases by one each row).

If there is a match for the model number + "Yes" + the counter, then the formula will index against columns A:S on the SS tab and use the MATCH function to pull in the relevant row. Finally, the "4" at the end is telling the Index function what column to pull in. In this case, I wanted column D, which is the 4th column in the range A:S.

Take care,
Ben

Thanks for both ideas Ben.

I had the most success with the code.

The first formula for the index worked fine, but I had issues with the second one to go in the target tab. It kept trying to open new workbooks and the data did not get pulled across.

I will try and split up your code so I can have a set of tab specific subs to do the data transfers. I also want to try and get the data without the blank lines, more on the lines of my Pseudo code, as I ended up with rows with no formulae in columns G through M in the noVM tab.

This might take more work at the front end but I should not need to change it much once it is working.

Notice what an optimist I am ;)

I will let you know how I get on.

Thanks again Ben for your inspiration to kick me off :)


I have added the following code to the TAB code page and it transfers the correct data with no blank lines.

All I need now is an easy way to manually trigger the sub without going in to the developer ribbon.

Is it possible to add something to the Data ribbon which will run this sub name on the current tab?

Sub ParseData()
Dim lRow As Long
Dim lsCol(1 To 5) As Long
Dim ldCol(1 To 5) As Long
Dim x As Long
Dim sr As Long
Dim dr As Long

'This sub will copy all pertinent data from the SS tab and copy it to current tab hopefully



Application.ScreenUpdating = False 'Speeds up macro

'Last row of data on SS tab Sheet8
lRow = Sheet8.Range("A3000").End(xlUp).Row

'Set the column references for the SS tab
lsCol(1) = 6
lsCol(2) = 7
lsCol(3) = 5
lsCol(4) = 13
lsCol(5) = 14

'Set the column reference number for the Users tab
ldCol(1) = 1
ldCol(2) = 2
ldCol(3) = 4
ldCol(4) = 5
ldCol(5) = 6

'Copy data to tabs (Note: only copying the pertinent columns)
'Sheet8 is SS and Sheet4 is 7945 Users
dr = 2
For sr = 2 To 3000
If Sheet8.Cells(sr, 3).Value = 7945 And _
Sheet8.Cells(sr, 8).Value = "Yes" Then
For x = 1 To 5
Sheet8.Cells(sr, lsCol(x)).Copy
Sheet4.Cells(dr, ldCol(x)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Next x
dr = dr + 1
Else
'Do Nothing
End If
Next sr



Application.ScreenUpdating = True

End Sub

I'm happy to help and glad to hear that things seem to be heading the right direction. Best of luck.

Ben

You might try changing the sheet name in the sub to "ActiveSheet" (i.e., find and replace "Sheet4" with "ActiveSheet"). Then, you could assign a keyboard shortcut to the macro. By changing the destination sheet to the active sheet, then the sub will run on whatever sheet was active when the keyboard shortcut was used.

If you use this method, you may want to add some form of validation at the beginning of the sub so that it doesn't inadvertently run on the wrong tab. This could be handled with one line:

If ActiveSheet.CodeName < "Sheet4" And ActiveSheet.CodeName < "Sheet5" Then Exit Sub

Another option might be to add a button to each sheet and tie the macro to that button. If you really need an option on the ribbon, I can't be of much help. But there is an article on the subject at http://msdn.microsoft.com/en-us/libr.../ee767705.aspx.

Ben

Hi

You could try triggering it when you open the workbook.

Private Sub Workbook_Open()

Call ParseData

End Sub

HTH
Mick.

Thanks again Ben.

The issue I have is that each sheet has a sub ParseData() and the criteria for the data and the cells copied can be different for each sheet.
I did think about the button route as I have used that before to sort result league tables after they have been updated.

i will look into that link you provided to see if I can get the equivalent of the button but not embedded on the sheet. I do not think I will have much success though after thinking about it. Still worth a try.

Thanks Mick.

I currently have a copy of the ParseData code under Private Sub Worksheet_Activate() with a check so it will only run if there is no data in the sheet.
What I need now is a manual update option.
I did think about adding a dialog at the start of the Worksheet_Activate() to ask if an update is required and then remove the data exists check but I do not know how to do this.

I managed to get a dialog box designed with text and two option buttons but how to get this to display and then receive the information on which button is pressed is beyond me. I was thinking that one button would return true and the other false.

Thanks to all who helped my brain get firing ;)

Here is my current solution, which also has the manual update thing fixed.

Code on the tab:

Private Sub Worksheet_Activate()

Dim Query As String


'This sub will copy all pertinent data from the SS tab and copy it to current tab hopefully

If ActiveSheet.Cells(2, 1) = "" Then

ParseData
Else
'Ask whether to Update
Query = InputBox("Update Data? Y/N", "User Input")
If Left(Query, 1) = "Y" Or Left(Query, 1) = "y" Then
ParseData
Else
'Do Nothing
End If

End If

Application.ScreenUpdating = True

End Sub


Private Sub ParseData()
Dim lRow As Long
Dim sr As Long
Dim dr As Long

'This sub will copy all pertinent data from the SS tab and copy it to current tab



Application.ScreenUpdating = False 'Speeds up macro

'Last row of data on SS tab Sheet8
lRow = Sheet8.Range("A3000").End(xlUp).Row

'Copy data to tabs (Note: only copying the pertinent columns)
'Sheet8 is SS
dr = 2
sr = 2
Do
If Sheet8.Cells(sr, 3).Value = CInt(Left(ActiveSheet.Name, 4)) And _
Sheet8.Cells(sr, 8).Value = "Yes" Then 'Check for VM user
Call PhoneDataCopy(sr, dr)
dr = dr + 1
sr = sr + 1
Else
sr = sr + 1
End If

Loop Until Sheet8.Cells(sr, 1) = "z"


Application.ScreenUpdating = True

End Sub


Then I have a module with the PhoneDataCopy function in it as follows:

Function PhoneDataCopy _
(ByVal Source_Row As LongPtr, ByVal Destination_Row As LongPtr)
Dim lsourceCol(1 To 5) As Integer
Dim ldestinationCol(1 To 5) As Integer
Dim x As Integer

'This sub will copy all pertinent Phone data from a row on SS tab and copy it to a row on current tab



'Set the column references for the SS tab
lsourceCol(1) = 6 'MAC address
lsourceCol(2) = 7 'Full Name
lsourceCol(3) = 5 'NTID
lsourceCol(4) = 14 'E164 Extension Number
lsourceCol(5) = 15 'Line COS String

'Set the column reference number for the Phone Destination tab
ldestinationCol(1) = 1
ldestinationCol(2) = 2
ldestinationCol(3) = 4
ldestinationCol(4) = 5
ldestinationCol(5) = 6


'Copy data to tabs (Note: only copying the pertinent columns)
'Sheet8 is SS
For x = 1 To 5
Sheet8.Cells(Source_Row, lsourceCol(x)).Copy
ActiveSheet.Cells(Destination_Row, ldestinationCol(x)).PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
Next x



End Function




It could probably be tidied up but it does the job and I can tailor it for the other tabs where the criteria are different.

Thanks again to all who replied.