Posts by VBA Noob

Re: HELP! need to rid fields of strange Social Security numbers

Please don't cross post

http://www.excelforum.com/showthread.php?t=592963

VBA Noob

Re: Display A Picture Based On A Cell Value

This link might help

http://www.mcgimpsey.com/excel/lookuppics.html

or a non VBA way

http://www.jkp-ads.com/Articles/ShowPicture00.htm

VBA Noob

Re: Run-time Error '424'

Maybe your other post will help

http://www.excelforum.com/showthread.php?t=590441

VBA Noob

Re: Count Records

Try

=SUM(IF(FREQUENCY(IF(LEN(I2:I17)>0,MATCH(I2:I17,I2:I17,0),""),IF(LEN(I2:I17)>0,MATCH(I2:I17,I2:I17,0),""))>0,1))

VBA Noob

Re: Formula To Find Similar Data In Columns

pangolin,

You could use this non VBA array

=SUMPRODUCT(--(LEFT(B9:B30)={"D","E","Y"}))

VBA Noob

Re: Text Formula? Postcodes

Hi,

This might help

=IF(ISERROR(VALUE(MID(A3,2,1))={1,2,3,4,5,6,7,8,9,0}),LEFT(A3,2),LEFT(A3,1))

VBA Noob

Re: Add Row In Sum Formula

Hi,

Howabout

Quote

=SUM(OFFSET($A$1,0,0,COUNTA(A:A),1))

VBA Noob

Re: Looping on Criteria

Hi Dave,

Adapted from code from Ron de Bruin

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim lastrow As Long


Set ws1 = Sheets("Sheet1")
Set rng = ws1.Range("A13").CurrentRegion
Sheets("Template").Visible = True
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With


With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True


Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value


For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Sheets("template").Copy after:=ws1
Set WSNew = ActiveSheet
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A6"), _
Unique:=False


With WSNew
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("O5:AW5").AutoFill Destination:=.Range("O5:AW" & lastrow) _
, Type:=xlFillDefault
    .Range("O1:AW4").Cut
    .Range("O3").Select
    ActiveSheet.Paste
    .Columns("T:AH").EntireColumn.Hidden = True
    .Rows("1:2").Delete Shift:=xlUp
     .Range("A:C,E:E,J:J,M:M").EntireColumn.Hidden = True
     .Range("A1").Select
End With


Next
.Columns("IU:IV").Clear
End With


With Application
.ScreenUpdating = True
.Calculation = xlAutomatic
End With
Sheets("Template").Visible = False
End Sub

VBA Noob

Re: Looping on Criteria

Thanks Aaron,

Think I've cracked it now.

I used a unique filtered list and pasted the values into a template sheet which had the formulas and heading in Row 1 & 2 . Then I dragged the formulas down.

VBA Noob

Re: Looping on Criteria

Sounds like it would be useful.

Can you post the example ??

VBA Noob

Re: Looping on Criteria

Indeed I do but not sure where to start

Is there a good example of this anywhere or could you post some code I can try to adapt to

VBA Noob

Quote from Aaron Blood

Oh... what you need to do is create an array of unique names, then loop thru the array and find all instances of each name and copy/paste to a new sheet.

Re: Looping on Criteria

Sorry,

I've sorted the list on Column A. There are about 29 names in Column A from A14 down.

I want the Loop to find the first name A14 until it sees a change say A17 then copy range A14 to AW17 and paste special the values and formulas for A14 to AW17 to a new sheet. It should change the Sheet name to the person name in A14.

It should loop through until all 29 names have being done

VBA Noob

Hi,

Not to hot on looping so looking for help.

Starting cell is A14.

Want to paste special formulas and values A14 to AW14 to a new sheet and then loop through all cells down form A14 to see if they match A14 value. When it finds a new value it should repeat the loop.

Any help appreciated

VBA Noob

Re: Looping code & AutoFilter criteria

Dave,

It works but paste values not my formula's.

Any tips ??

VBA Noob

Re: Looping code & AutoFilter criteria

Thanks Dave.

Will give it a go today

VBA Noob

Re: Looping code & AutoFilter criteria

Here's a simple example of what I'm trying to do

Contol sheet shows rough layout of data with mix of values and formulas

The "John" tab is the new sheet with Formatting and Values and Columns. Need autofilter each unique name in list and create a new sheet for each

I was going to then use Ron's "Mail every WorkSheet with address in A1 with SendMail" to send sheets once e-mailled I was going to delete all sheets to the left off Control sheet.

VBA Noob

Re: Looping code & AutoFilter criteria

Here it is

Main sheet called Control Panel.
A14 down will have the range for AdvanceFilter.
120 rows with around 27 unique names.
Extra aheaders in A10:AW12 to copy.
Current region is A13:W133. Paste to A13 in new sheet (formatting, Column Widths values and formulas)
Hidden columns in T to AH. So will have to unhide and rehide in new sheet and orginial.
Will be e-mailing them so need to Kill them after I e-mail them so moving to begin ActiveSheet.Move Before:=Sheets(1)

Some code I'm being working on

Sub Copy_With_AdvancedFilter_To_Worksheets()
    Dim CalcMode As Long
    Dim ws1 As Worksheet
    Dim WSNew As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim cell As Range
    Dim Lrow As Long


 
    ActiveSheet.Unprotect
    Set ws1 = Sheets("Control panel")  '<<< Change
    
    'Tip : Use a Dynamic range name, http://www.contextures.com/xlNames01.html#Dynamic
    'or a fixed range like Range("A1:H1200")
    Set rng1 = ws1.Range("EM").CurrentRegion  '<<< Change
    Set rng2 = ws1.Range("A10:AW12")  '<<< Change
    
    Columns("T:AH").EntireColumn.Hidden = False
   


    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With


 


    With ws1
        rng1.Columns(1).AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=.Range("IV1"), Unique:=True


        'This example filter on the first column in the range (change this if needed)
        'You see that the last two columns of the worksheet are used to make a Unique list
        'and add the CriteriaRange.(you can't use this macro if you use the columns)




        Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
        .Range("IU1").Value = .Range("IV1").Value


 


        For Each cell In .Range("IV2:IV" & Lrow)
            .Range("IU2").Value = cell.Value


            Set WSNew = Sheets.Add
            ActiveSheet.Move Before:=Sheets(1)
            On Error Resume Next
            WSNew.Name = cell.Value
            If Err.Number > 0 Then
                MsgBox "Change the name of : " & WSNew.Name & " manually"
                Err.Clear
            End If
            On Error GoTo 0


            rng1.AdvancedFilter Action:=xlFilterCopy, _
                               CriteriaRange:=.Range("IU1:IU2"), _
                               CopyToRange:=WSNew.Range("A13"), _
                               Unique:=False
                               'Selection.PasteSpecial Paste:=xlPasteFormulas
            rng2.Copy
            ActiveSheet.Range("A10").Select
            ActiveSheet.Paste
            
            WSNew.Columns.AutoFit
        Next
        .Columns("IU:IV").Clear
        .Columns("T:AH").EntireColumn.Hidden = False
    End With 


    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With
End Sub

Thanks for bearing with me on this one Markc

VBA Noob

Re: Looping code & AutoFilter criteria

Sorry markc,

Was after the formulas to paste not the values

VBA Noob

Quote from markc

Noob -
It does paste as values as written
Just to test I dropped in a throw-away frmla in a cell I knew would be copied in the filtered results.

I then ran the macro to inspect the results
Sure enough, the frmla was replaced by a value.

Regards,
-marc

Display More

Re: Looping code & AutoFilter criteria

Hi markc,

Is it possible to paste special the values as I've got formula's in my selection

Thanks in advance

VBA Noob

Quote from markc

Noob -

I recommend Advanced Filter over Autofilter
I have seen Auto Filter not return correct results

Below is a sample from one my wb's that Nori helped me with
This code examines for existence of a string on a line
If found then switch is added else 0

I then use Advanced Filter to filter for the switched results and copy
any items matching criteria to a new wrksht

Take a look, give it a go, come on back if any qustions

Regards,
-marc

Code

Option Explicit


Sub comp_ldg_ChkForCashWrksht()
    Dim wbBook As Workbook
    Dim wsData As Worksheet
    Dim wsWCR As Worksheet
    Dim rngData As Range
    Dim rngCrit As Range
    Dim rngDest As Range
    Dim arrCrit
    Dim myRange As Range
    Dim C As Range
    Dim lngrows As Long
    Dim strFormula As String
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False


    Set wbBook = ThisWorkbook
    Set wsData = wbBook.Worksheets("Data")
    Set wsWCR = wbBook.Worksheets("WCR")
    
    lngrows = wsData.Range("A65536").End(xlUp).Row
    strFormula = "=IF(ISERROR(FIND(""WCR-"",$G2)),0,IF(FIND(""WCR-"",$G2),""/WCR"",0))"
    
    With wsData
        .Range("Q2:Q" & lngrows).Formula = strFormula
        .Range("Q2:Q" & lngrows).Value = .Range("Q2:Q" & lngrows).Value
    End With
    
    wsWCR.UsedRange.Clear
    
    Set rngData = wsData.Range("A1:Q" & lngrows)
    Set rngDest = wsWCR.Range("A1")


    arrCrit = Array("Switches", "/WCR")
    Set rngCrit = wsData.Range("IV1:IV2")
    
    rngCrit = WorksheetFunction.Transpose(arrCrit)
     
    rngData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCrit, CopyToRange:=rngDest, Unique:=False
    rngCrit.ClearContents
    
    'Reset / Cleanup
    Set wbBook = Nothing
    Set wsData = Nothing
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    
End Sub

Display More

Display More

Re: Looping code & AutoFilter criteria

Thank you both.

VBA Noob