Calling all excel gurus

Status
Not open for further replies.
estebanrey said:
Here you go.

Bear in mind, there are A LOT of vlookups in this so there is a recalculation delay when entering data into each cell. You can type past this (so only recalculate after the last column entry

You can also remove a lot of the rows if you want. Currently it can take 5,000 entries in total and 500 for each letter. Just delete the rows on each tab to reduce the number of formulas as I'm guessing they don't have that many members.

Or you can turn off automatic calculation and teach grandma how to press F9 to do it manually.

P.S Remember not to do a whole row delete to remove data in the data tab as this will delete the formulas in the hidden columns!

https://www.dropbox.com/s/hdq1lqkunxyircu/example.xlsx?dl=1
Click to expand...

You have made an old man very happy matey, thank you very much :) xxx
 
if you're using excel 2013, you could have the whole list on one sheet, convert it to a table and insert a slicer to filter on a column base on the first letter of the surname.

E2Ghx0hh.png.jpg


The only formula would be the one used to get the first letter :)
 
Fair play for going to the effort putting together that spreadsheet with a billion vlookup calculations but the outcome is bonkers - the main data source has changed to the single main spreadsheet in any event which was half the problem!

If you're going to continue, at least protect the tabbed letter worksheets or 100% guaranteed the old dears will just carry on doing data entry on the alphabet tabs thereby immediately rendering the main source out of date. :p

This is the VBA code you need to solve your original problem btw : http://www.excel-user.com/2009/10/vba-combine-sheets-data-into-one-sheet.html

You could mess around with updating automagically when the tabbed sheets update but could be messy and resoure-intensive - given the level of expertise I'd either add a shortcut button on the taskbar or better, have the macro run when the file is saved. The below has the save function added in :

Code: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'This macro will copy all rows from the first sheet
    '(including headers)
    'and on the next sheets will copy only the data
    '(starting on row 2)

    Dim i As Integer
    Dim j As Long
    Dim SheetCnt As Integer
    Dim lstRow1 As Long
    Dim lstRow2 As Long
    Dim lstCol As Integer
    Dim ws1 As Worksheet

    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    On Error Resume Next

    'Delete the Target Sheet on the document (in case it exists)
    Sheets("Target").Delete
    'Count the number of sheets on the Workbook
    SheetCnt = Worksheets.Count

    'Add the Target Sheet
    Sheets.Add after:=Worksheets(SheetCnt)
    ActiveSheet.Name = "Target"
    Set ws1 = Sheets("Target")
    lstRow2 = 1
    'Define the row where to start copying
    '(first sheet will be row 1 to include headers)
    j = 1

    'Combine the sheets
    For i = 1 To SheetCnt
        Worksheets(i).Select

        'check what is the last column with data
        lstCol = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column

        'check what is the last row with data
        lstRow1 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row

        'Define the range to copy
        Range("A" & j, Cells(lstRow1, lstCol)).Select

        'Copy the data
        Selection.Copy
        ws1.Range("A" & lstRow2).PasteSpecial
        Application.CutCopyMode = False

        'Define the new last row on the Target sheet
        lstRow2 = ws1.Cells(65536, "A").End(xlUp).Row + 1

        'Define the row where to start copying
        '(2nd sheet onwards will be row 2 to only get data)
        j = 2
    Next

    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Sheets("Target").Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select

End Sub
 
Last edited:
1. create a sheet called "emails"

run

Code: 
Sub emails()


Dim wbList As Workbook
Set wbList = ActiveWorkbook


For Each ws In wbList.Worksheets
    For Each c In ws.UsedRange.Cells
        If (InStr(c, "@")) <> 0 Then
            c.Copy Sheets("emails").Range("a" & Rows.Count).End(xlUp)(2)
        End If
        
    
    Next
Next

Set wbList = Nothing


End Sub

You could refine this to refresh on open and maybe speed it up by replacing usedrange with something more specific
 
The vlookup spreadsheet works a charm, I actually understand whats going with that one, I'll have a play around with the two routines kindly mentioned above but for now I'm one happy camper :)
 
Status
Not open for further replies.
Back
Top Bottom