Posts by Simon Lloyd

Re: Hwo To Find Day Of The Week As Text

Firehorse, i know this sounds a bit lame but for your other questions you will have to start a new thread! as they are a different topic, it's the rules of this forum i'm afraid!

Glad your sorted on the date front anyway!

Re: Identify Duplicates Between 2 Columns Of Different Sheets

Look have a play around with the Offsets and the Rng & Rng1 changing the lettering, you will see what is happening when you change them and run the code from there you should be able to work it out....believe me learning and sorting it out for your self is the best way to go as you will always keep that skill!

Re: Workbooks.open In Macro Code

As long as you are setting mypath1 correct and my name this should work:

Sub Macro2()
Dim MyPath1 as string, MyName as string
MyPath1=Thisworkbook.path
MyName = 'whatever
    strVar = mypath1 & "/" & myname & ".xls"
    Workbooks.Open Filename:=strVar
     
     MsgBox "Hello World"
End Sub

Re: Hwo To Find Day Of The Week As Text

like this =TEXT(A1,"DDDD")

Added by admin
=A1 in B1 and Custom Format as Dddd

Re: Identify Duplicates Between 2 Columns Of Different Sheets

Sub Find_All_Dates() 
    Dim Rng As  Range, Rng1 As Range, MyCell As Range, Cell As Range 
    Set Rng =  Sheets("Customers").Range("A1:" & Range("A65536").End(xlUp).Address) 
    Set Rng1 = Sheets("Orders").Range("A65536").End(xlUp) 
    For Each MyCell In Rng 
        With Sheets("Orders").Range("A:A") 
            . AutoFilter Field:=1, Criteria1:=MyCell 
        End With 
        For Each Cell In Sheets("Orders").Range("A2:" & Rng1.Address).SpecialCells(xlCellTypeVisible) 
            If Cell.Value <> "" Then 
                MyCell.Offset(0, 1).Value = MyCell.Offset(0, 1).Value & "," & _ 
                Cell.Offset(0, 1).Value 
            Else: Goto Nxt 
            End If 
        Next 
         
Nxt: 
    Next 
    sheets("Orders").autofiltermode=False 
End Sub

Customers and orders now sorted!

As for the rest figure it out!, you didnt't supply all that information when you requested a solution for which i spent my valuable free time....only to find you have changed the goal posts!

Re: Protect All Sheets Then Close Workbook

Use the macro recorder to produce the code you want for protecting a sheet then insert it in this!

Private Sub Workbook_BeforeClose(Cancel As Boolean)
For Each Sheet In Sheets
'YOUR PROTECT CODE HERE
Next Sheet
ThisWorkbook.Save


End Sub

this code goes in the ThisWorkbook module.

Re: Date Format

custom format a cell to dd mmm, or ddd for full day name and mmmm for full month try experimenting with them!

Re: macro to runs when a user enters a value in the 'Numbers' column

This should do what you want, place it in the Summary worksheet module (Alt+F11, the double click the summary sheet on the left hand side).

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Dim i As Integer
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
 If Not Intersect(Target, Range("A2,A3")) Is Nothing Then Exit Sub
Set Rng = Sheets(Target.Offset(0, -1).Value).Range("A1:" & Range("A65536").End(xlUp).Address)
For i = 0 To Target.Value
Rng.Copy Destination:=Sheets(Target.Offset(0, -1).Value).Range("A65536").End(xlUp).Offset(1, 0)
Next i
End Sub

Edited the code to correct sheet after reading your update!

Re: Identify Duplicates Between 2 Columns Of Different Sheets

Ok try this:

Sub Find_All_Dates()
Dim Rng As Range, Rng1 As Range, MyCell As Range, Cell As Range
Set Rng = Sheets("Sheet2").Range("A1:" & Range("A65536").End(xlUp).Address)
Set Rng1 = Sheets("Sheet1").Range("A65536").End(xlUp)
For Each MyCell In Rng
With Sheets("Sheet1").Range("A:A")
.AutoFilter Field:=1, Criteria1:=MyCell
End With
For Each Cell In Sheets("Sheet1").Range("A2:" & Rng1.Address).SpecialCells(xlCellTypeVisible)
        If Cell.Value <> "" Then
        MyCell.Offset(0, 1).Value = MyCell.Offset(0, 1).Value & "," & _
        Cell.Offset(0, 1).Value
        Else: GoTo Nxt
        End If
    Next
    
Nxt:
    Next
sheets("Sheet1").autofiltermode=false
End Sub

Re: macro to runs when a user enters a value in the 'Numbers' column

I have looked at your file, you need to do a little more design work and explanation, if a user typed a number in the numbers column of the summary sheet lets say 3 opposite sheet2 what would that 3 mean to the macro? would it mean only copy the first 3 rows? would it mean find all number 3's...and if it was to copy multiple rows or a block of data how should that be shown on the summary sheet as you have sheet2 and directly underneath sheet3?

Re: Biggest Loser

Jugsy, welcome to Ozgrid, a quick word of warning, the rules here are strictly adhered to and a moderator may ban you from posting because your thread title doesnt explain what you are after, you need to go to Thread Tools and edit thread to change the title perhaps to Gains and Loss Calculations including percentages? or something along those lines, the reason for the strict thread title is for search purposes, had you typed thos particular words in the search box it will bring all those threads matching it giving you a perhaps faster and more varied solution, so it would help others in your situation.

I am not a moderator at this forum but am at another and know how frustrated folk can get because they have had a post banned or deleted.

Re: Identify Duplicates Between 2 Columns Of Different Sheets

Yes, i understand that but would you want the dates one under the other or in the same cell?, because one under the other means inserting a row(s) between your customers to allow for multiple dates!

Re: Identify Double Entries

Highlight your enitire used range, give it a range name (say call it MyRange), then select conditional formatting and using formula is add this: =IF(COUNTIF(MyRange, A1)>1,TRUE,FALSE)

Re: Identify Duplicates Between 2 Columns Of Different Sheets

If you have your customers listed contiguously in the customers sheet how do you propose you get more than one date found for a customer in column B? the date would look like it belonged to the next customer!

Re: Increment Cell Value & Print Sheet At Each Step

Perhaps you need it in the worksheet module (ALt+F11, then double click the name of the worksheet you want on the left hand side)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Integer
 Dim ib As Variant
 ib = Application.InputBox("Enter amount of increments", "Cell Progression", , , , , 1)
 If Target <> Range("J2") Then Exit Sub
    For i = 0 To ib
         Range("J2").Value = Range("J2").Value + 1
        ActiveSheet.PrintOut
    Next i
End Sub

Re: Increment Cell Value Then Print

Try this:

Sub Increase_Cell_n_Print()
Dim i As Integer
For i = 0 To 220
Range("A1").Value = Range("A1").Value + 1
Activesheet.printout
Next i
End Sub

Re: Code Works In Break Mode , But Not Runtime

Try it this way round:

Dim MyBook As String
Do
Application.DisplayAlerts = False
    Sheets.Add
    ChDir Path
    Workbooks.Open Filename:=Path & Name
    MyBook = ThisWorkbook.Name
    ActiveSheet.UsedRange.Copy
    Workbooks("Project.xls").Worksheets(1).Activate
    Workbooks(MyBook).Close
    ActiveSheet.Paste
    i = i + 1
    Application.CutCopyMode = False
Loop

Re: Copy / Filter Data Based On Data In Column Occuring x Times

if you prefer a code version, assuming your data is on sheet2:

Sub Sheets_By_Domain_Over_Ten()
    Dim wSheetStart As Worksheet
    Dim strText As String
    Dim rngSource As Range, rngUnique As Range
    Dim rngSourceLess As Range
     Application.ScreenUpdating = False
    Set wSheetStart = ActiveSheet
    wSheetStart.AutoFilterMode = False
    Set rngSource = wSheetStart.Range(Cells(1, 4), Cells(Cells.Rows.Count, "D").End(xlUp))
    Set rngSourceLess = wSheetStart.Range(Cells(2, 4), Cells(Cells.Rows.Count, "D").End(xlUp))
     
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("UniqueList").Delete
    Worksheets.Add().Name = "UniqueList"
     
    With Worksheets("UniqueList")
         
        rngSource.AdvancedFilter xlFilterCopy, rngSource, .Range("A1"), True
        Set rngUnique = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With
    On Error Resume Next
    
    On Error GoTo 0
     
    For Each cell In rngUnique
         
        With wSheetStart
        wSheetStart.Activate
        On Error Resume Next
mp = Evaluate(Application.WorksheetFunction.CountIf(Range(Cells(2, 4), Cells(Cells.Rows.Count, "D").End(xlUp)), cell.Value))
            If mp < 10 Then GoTo Nxt
              Worksheets("UniqueList").Range("A1").AutoFilter 1, cell.Value
            Worksheets(cell.Value).Delete
            Worksheets.Add().Name = cell.Value & " Data"
            .Activate
            Cells(1, 4).AutoFilter Field:=4, Criteria1:=cell.Value
            rngSourceLess.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Worksheets(cell.Value & " Data").Range("A1")
              
            If cell.Value = "" Then Exit For
            .AutoFilterMode = False
            .Activate
        End With
Nxt:
             
    Next cell
     
    wSheetStart.AutoFilterMode = False
    Sheets("UniqueList").Delete
    Application.DisplayAlerts = True
     Application.ScreenUpdating = True
End Sub

Re: Automatically Create Worksheets Based On Row Data

Considering both explanations you gave were different i suggest that you upload a test workbook here with the before and after manipulation with a short note, that way you will get the response you need!

Re: Automatically Create Worksheets Based On Row Data

something like:

Sub Create_Wbooks()
Dim Rng As Range, MyCell As Range
Set Rng = Sheets("Sheet1").Range("A2", Range("A65536").End(xlUp))
For Each MyCell In Rng
Workbooks.Open ("C:\YOUR WORKBOOK OR PATH.xls")
Sheets.Add
ActiveSheet.Name = MyCell.Value
Next MyCell
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub